【EXCEL-VBA】シートの有無を確認してからワークシートを削除したい

Question

お世話になっております。

ワークシートの有無を確認してからシートを削除するマクロを作りたいと思っています。
特定の名前のシートを削除するマクロを以前、こちらで頂いたので、
それをカスタマイズしようと思ったのですが、、、まだ実力不足でできませんでした。

以前いただいたマクロはこちらです
「EXCEL-VBA ワークシートを4枚削除するマクロを作成したい」
https://bitly.is/1g3AhR6

カスタマイズできなかった理由ですが、
確認するシート名がSheetAのA20、A21、A22にあります。

要するに取得したA20、A21、A22値を元にワークシートの有無を
確認しなければならないのですが、そのためのコードが書けませんでした。

すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
教えて下さい。よろしくお願いします。

コードはリンク先のものを利用して頂いてもOKですし、
新規に書き上げて頂いてもOKです。

お手数ですが、よろしくお願いします。

追記
前回、教えて頂いたtatsu99さん、tom04さん、bonaronさん、
ありがとうございました。

tom04 · Accepted Answer

No3です。

https://oshiete.goo.ne.jp/qa/9543475.html
の関連質問だったのですね？

No.3は単純にシートを削除するだけで
Sheet1のA20～A22セルのシート名が存在しない場合のメッセージは表示させていませんでした。
↓のコードにしてみてください。

Sub Sample2()
    Dim c As Range, k As Long, myStr As String, myFlg As Boolean
    For Each c In Worksheets("Sheet1").Range("A20:A22")
        myFlg = False
    For k = Worksheets.Count To 2 Step -1
        If Worksheets(k).Name = c Then
            myFlg = True
            Application.DisplayAlerts = False
                Worksheets(k).Delete
            Application.DisplayAlerts = True
        End If
    Next k
        If myFlg = False Then
            myStr = myStr & "[" & c & "]" & ","
        End If
    Next c
        If myStr <> "" Then
            MsgBox "Sheet" & Left(myStr, Len(myStr) - 1) & "はありませんでした。"
        End If
End Sub

※　すべてのシートが存在した場合は
メッセージボックスは表示されません。m(_ _)m

tatsu99 · Answer

No9です。
＞マクロを実行してみなさい、、、ということだと思ったのですが、、、
＞やってみたところエラーで止まります。

すみません。私の誤りでした。
Public Sub MacroXXX()
If ExistsWorkSheet("SHEET1") Then
MsgBox ("SHEET1あり")
Else
MsgBox ("SHEET1なし")
End If
End Sub

の
If ExistsWorkSheet("SHEET1") Then
を
If CheckExistSheet("SHEET1") Then
に変えてください。

大変、失礼しました。お詫びして訂正いたします。

tatsu99 · Answer

No5です。
>不思議に思っていたのですが、
>今回のマクロは
>Public Sub Macro1()
>～
>End Sub
>～
>End Function
>とEnd のついたところが2つあります。
>Public Sub 名前()というプロシージの時は
>End Sub
>～
>End Function
>の2つEndが必要ということでしょうか？

私が提供したマクロは
マクロ本体の
①
Public Sub Macro1()
～
End Sub

とサブプロシージャである
'ワークシートの存在チェック
②
Public Function ExistsWorkSheet(ByVal sheetName As String) As Boolean
～
End Function

の２つからできています。
サブプロシージャは、ほかのプロシージャから呼び出されることを前提に
作っています。
この②は、引数で指定されたワークシート名が、ブック中に存在するか否かのチェックを行い、
存在すれば、true、しなければ、falseを返す処理をおこないます。
①のなかで、
If ExistsWorkSheet(sheetName) = True Then
のステートメントがありますが、これが、実際に②を呼び出している部分です。
sheetNameには、A20～A22の内容がセットされるので、このA20～A22のシートがあるかどうか
の判断を行っていることになります。
サブプロシージャは、他のプロシージャからも呼び出せます。
もし、今回、
Public Sub Macro1()
End Sub
の後に
Public Sub Macro2()
End Sub
Public Sub Macro3()
End Sub
のように２つのプロシージャを追加した場合、
②のExistsWorkSheetをMacro2,Macro3から呼び出すことができます。

サブプロシージャを作ると、何が嬉しいのかということですが、
「同じプログラムを２度書かないですむ」ということです。
今回の②のExistsWorkSheetを1度作成しておけば、
今後、どのプロシージャからでも、このExistsWorkSheetを呼び出せば
簡単にワークシートの存在の有無のチェックが可能になります。

尚、くんこばさんが提供された
No2の
Function f000_sample
No7の
CheckExistSheet
もこれに該当します。

今回、私の②のExistsWorkSheetと
くんこばさんのf000_sample、CheckExistSheet
は全く同じ、引数、戻り値なので
私のMacro1の中の
If ExistsWorkSheet(sheetName) = True Then　のかわりに
If f000_sample(sheetName) = True Then　か
If CheckExistSheet(sheetName) = True Then　としても
全く同じ結果になります。

但し、くんこばさんのマクロを使用すると、
No6で私が指摘したように、シート名が変わってしまいます。
（Sheet1があった状態で、SHEET1があるかチェックをするとシート名がSHEET1になります）
今回の案件の場合は、シートがあれば、削除するので、シート名が変わっても、どのみち
問題ないのですが、
シートの有無のチェックだけを行い、あっても、なくても、そのシートを削除しない場合に
問題になります。

時間があれば、自分で以下の確認をしてください。
くんこばさんのCheckExistSheetを登録します。
更に、以下のマクロを作成し、実行してください。
Public Sub MacroXXX()
    If ExistsWorkSheet("SHEET1") Then
        MsgBox ("SHEET1あり")
    Else
        MsgBox ("SHEET1なし")
    End If
End Sub

実行時、Sheet1が存在する状態で呼び出すと、「SHEET1あり」が表示され、その後、
Sheet1がSHEET1に代わります。Sheet1がない状態で呼び出すと、「SHEET1なし」が
表示されます。
尚、このシート名が変わってしまうのは、よくないので、これを変えたい場合は、
No8でbonaronさんが提示した方法を採用すればよいかと。

bonaron · Answer

No.7 さんへ

No.6 さんのご指摘について No.7 でも改善されていないので、
その対策を。

代入を逆向きにすれば良いですね。

Public Function CheckExistSheet(ByVal sheetname As String) As Boolean
　　On Error GoTo exit_proc
　　Dim ret As Boolean
 　　ret = False
　　sheetname = Worksheets(sheetname).Name
　　ret = True
exit_proc:
　　CheckExistSheet = ret
End Function

あるいは
Worksheets(sheetname).Name = Worksheets(sheetname).Name & ""
とか。

くんこば · Answer

'==============================================================
'   シート名の存在チェック
'==============================================================
Public Function CheckExistSheet(sheetname As String) As Boolean
On Error GoTo exit_proc
    Dim ret As Boolean
    ret = False
    Worksheets(sheetname).Name = sheetname
    ret = True
exit_proc:
    CheckExistSheet= ret
End Function

いつか理解できる日が来ることを願って。

tatsu99 · Answer

No4の方へ
あまり、回答者同士で批判しあうのは、好みませんが、1っだけ言わせてください。

>このコードは、strにシート名を指定すると、その存在を判定してくれる関数になります。
>VBA開いて、プロシージャに貼り付ければ、ワークシート関数としても利用出来ます。
>内容としては非常に簡単で、シートが存在しない場合エラーとなる処理があります。
>エラーとなったら存在しない、と判断してるわけです。

ということですが。
No2のソースは簡潔で素晴らしいのですが、１つ欠点がございます。
それは、そのFunctionを呼び出すと、シート名を変えてしまうことです。
例えば、ブック中に"sheet1"のシートがあり、"SHEET1"が存在するかどうかの
チェックの為、そのFunctionを呼び出すと、シート名が"SHEET1"に変わってしまいます。

従って、No2のFunctionをワークシート関数等の汎用的な関数として利用すると、
いつのまにか、シート名が変わっていて、利用者がおやっと思う可能性があります。
ですので、シート名を変えないで、シートの存在チェックを行うように改良していただければ、
そちらのほうが良いかと思います。

tatsu99 · Answer

以下のようにしてください。標準マクロへ登録します。
----------------------------------------------
Option Explicit

Public Sub Macro1()
    Dim sh1 As Worksheet
    Dim row As Long
    Dim sheetName As String
    Dim ctr As Long
    ctr = 0
    Set sh1 = Worksheets("SheetA")
    '20行～22行のA列を参照する
    For row = 20 To 22
        sheetName = sh1.Cells(row, "A").Value
        'シート名が空白でなく、且つ、存在するなら削除する
        If sheetName <> "" Then
            If ExistsWorkSheet(sheetName) = True Then
                Application.DisplayAlerts = False       'シート削除時の警告を出さないようにする
                Worksheets(sheetName).Delete            '該当シートを削除する
                Application.DisplayAlerts = True        'シート削除時の警告を出すようにする（元に戻す）
                ctr = ctr + 1
                MsgBox ("[" & sheetName & "]の削除完了")
            End If
        End If
    Next
    MsgBox (ctr & "件削除完了")
End Sub

'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal sheetName As String) As Boolean
    Dim ws As Worksheet
    ExistsWorkSheet = False
    For Each ws In Worksheets
        If UCase(ws.Name) = UCase(sheetName) Then
            ExistsWorkSheet = True
            Exit Function
        End If
    Next ws
End Function
---------------------------------------------
尚、以前、私が回答したマクロですが、
マクロの存在チェック（ExistsWorkSheet）にバグがありました。
バグの内容は、excelのシート名は大文字、小文字を区別しない為、
ブック中に[sheet1]が存在した状態で、[SHEET1]の存在チェックを行うと、Falseが返ってしまい、
存在しない扱いになってしまうことです。（シート名がSheet1でも同様です）
今回は、この不具合を修正しました。（両方、大文字にした後で比較するようにしました）
申し訳ありませんが、
以前のExistsWorkSheetは、今回提示したExistsWorkSheetで置き換えてください。
お詫びして訂正いたします。

又、マクロ中で確認の意味でメッセージボックスを表示していますが
不要であれば、削除してください。

くんこば · Answer

あ、やっぱり説明不足になりましたか。
サブプロシージャとか分かります？

このコードは、strにシート名を指定すると、その存在を判定してくれる関数になります。
VBA開いて、プロシージャに貼り付ければ、ワークシート関数としても利用出来ます。
内容としては非常に簡単で、シートが存在しない場合エラーとなる処理があります。
エラーとなったら存在しない、と判断してるわけです。
これだとコードは少なくて済みますので。

ちょっと変数名とか、適当過ぎましたね。
(^_^ ; )

利用方法としては、削除前にその判定を入れて、trueの時だけ削除するようにします。

帰宅して余裕があればコードも載せれますが、ちょっと厳しいかも…

tom04 · Answer

こんにちは！

＞A20、A21、A22の値の名前のワークシートがあれば
「Sheet1」のA20～A22の範囲とします。

一例です。

Sub Sample1()
    Dim k As Long, myRng As Range, c As Range
        Set myRng = Worksheets("Sheet1").Range("A20:A22")
        For k = Worksheets.Count To 2 Step -1   '←シート見出しの最後から2番目まで//
            Set c = myRng.Find(what:=Worksheets(k).Name, LookIn:=xlValues, lookat:=xlWhole)
                If Not c Is Nothing Then
                    Application.DisplayAlerts = False
                        Worksheets(k).Delete
                    Application.DisplayAlerts = True
                End If
        Next k
End Sub

こんな感じではどうでしょうか？m(_ _)m

くんこば · Answer

シートが存在すればtrue、なければfalse。
これじゃダメ？
Public Function f000_sample(str As String) As Boolean
On Error GoTo exit_kb
Dim ret As Boolean
ret = False
Worksheets(str).Name = str
ret = True
exit_kb:
f000_sample = ret
End Function

【EXCEL-VBA】シートの有無を確認してからワークシートを削除したい

No3です。

No9です。

No5です。

No.7 さんへ

'==============================================================

No4の方へ

以下のようにしてください。

あ、やっぱり説明不足になりましたか。

こんにちは！

シートが存在すればtrue、なければfalse。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング