ワークシートの削除（VBA）

Question

ワークシート削除処理について、現在下記構文で指定のワークシート名が存在していたら
そのワークシートを削除するということを実施しています。
逆に、指定のワークシート名以外のワークシートが存在していたらそれを削除する、みたい
なことをしたいのですが、どのようにすれば良いか構文をご教授お願い致します。
（例として、SHEET1、SHEET2、SHEET3、以外のワークシートが存在した場合、その3つの
　ワークシート以外のワークシートを削除。）

    Dim ws1 As Worksheet, flag As Boolean
        For Each ws1 In Worksheets
            If ws1.Name = "SHEET1" Then flag = True
        Next ws1
            If flag = True Then
                Worksheets("SHEET1").Delete
            Else
            End If
        Set ws1 = Nothing
        flag = False

        For Each ws1 In Worksheets
            If ws1.Name = "SHEET2" Then flag = True
        Next ws1
            If flag = True Then
                Worksheets("SHEET2").Delete
            Else
            End If
        Set ws1 = Nothing
        flag = False

bonaron · Accepted Answer

こんな感じでは？
大文字、小文字を区別しません。

Sub Sample()
　　Dim ShList As Variant
　　Dim sel() As Boolean
　　Dim cnt As Integer
　　Dim sh  As Variant
　　Dim i   As Integer
    
　　ShList = Array("SHEET1", "Sheet2", "SHEET3")
　　cnt = ActiveWorkbook.Sheets.Count
　　ReDim sel(1 To cnt)
    
　　On Error Resume Next
　　For Each sh In ShList
　　　　sel(Sheets(sh).Index) = True
　　Next
　　On Error GoTo 0
    
　　Application.DisplayAlerts = False
　　For i = cnt To 1 Step -1
　　　　If Not sel(i) Then
　　　　　　Sheets(i).Delete
　　　　End If
　　Next
　　Application.DisplayAlerts = True
End Sub

siffon9 · Answer

こんな感じでどうですか？

Sub test()
　　Dim ws As Worksheet
　　Dim wsNotDelete As Variant
　　Dim wsDelete As Variant
　　Dim i As Long
　　Dim shouldDelete As Boolean
　　
　　'削除しないシート名リスト
　　wsNotDelete = Array("Sheet1", "Sheet2", "Sheet3")
　　'削除するシート名リスト
　　wsDelete = Array()
　　
　　For Each ws In Worksheets
　　　　shouldDelete = True
　　　　For i = LBound(wsNotDelete) To UBound(wsNotDelete)
　　　　　　If ws.Name = wsNotDelete(i) Then
　　　　　　　　shouldDelete = False
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　If shouldDelete Then
　　　　　　'本シート名を削除するリストに追加
　　　　　　ReDim Preserve wsDelete(UBound(wsDelete) + 1)
　　　　　　wsDelete(UBound(wsDelete)) = ws.Name
　　　　End If
　　Next
　　
　　'Application.DisplayAlerts = False
　　'削除するリストのシートを削除
　　For i = LBound(wsDelete) To UBound(wsDelete)
　　　　Worksheets(wsDelete(i)).Delete
　　Next
　　'Application.DisplayAlerts = True
End Sub

WindFaller · Answer

>SHEET1、SHEET2、SHEET3、以外のワークシートが存在した場合、
>その3つの ワークシート以外のワークシートを削除。）

パターンを書き換えれば、いろんなバリエーションが可能です。
シート名を設定する時に、ミスするのは、全角・半角を混在することです。

'//標準モジュール
Sub WshDelete()
　Dim ws As Worksheet
　Dim ShNames As Variant
　Dim i As Long, j As Long
　Const PAT As String = "sheet[1-3]" '残すシート(小文字にする)
　Worksheets(Worksheets.Count).Select　'あまり意味がない
　For i = 1 To Worksheets.Count
　　If Not StrConv(Trim(Worksheets(i).Name), vbNarrow + vbLowerCase) Like PAT Then
　　　ShNames = ShNames & "," & Worksheets(i).Name
　　　j = j + 1
　　End If
　Next
　If (i - 1) > j And j > 0 Then
　　Worksheets(Split(Mid(ShNames, 2), ",")).Select
　　If MsgBox(j & " シートを削除してよろしいですか。", vbQuestion + vbOKCancel) = vbCancel Then
　　　Worksheets(1).Select
　　Else
　　　Application.DisplayAlerts = False
　　　ActiveWindow.SelectedSheets.Delete
　　　Application.DisplayAlerts = True
　　End If
　Else
　　MsgBox "削除できません。", vbCritical
　　Worksheets(1).Select　'シートグループの解除
　End If
End Sub

ワークシートの削除（VBA）

こんな感じでどうですか？

こんな感じでは？

>SHEET1、SHEET2、SHEET3、以外のワークシートが存在した場合、

似たような質問が見つかりました

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

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

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