Excel VBA 逆引き集 | シートを削除する（警告を出さない）

Excel VBA
スポンサーリンク

シートを削除する（警告を出さない）

警告ダイアログを出さずに安全に削除する定番パターンを、初心者向けにやさしく解説します。失敗しやすい「最後の1枚問題」「存在チェック」「後始末（DisplayAlerts復帰）」まで、コピペで使えるテンプレート中心にまとめました。

基本：警告なしで1枚削除する

最小コード（警告非表示＋削除）

Sub DeleteSheet_NoPrompt_Basic()
    Application.DisplayAlerts = False            '警告を一時的にオフ
    ThisWorkbook.Worksheets("一時シート").Delete '対象名を変更して使う
    Application.DisplayAlerts = True             '必ずオンに戻す
End Sub
VB
  • ポイント:
    • DisplayAlerts: 警告の表示をアプリ全体で制御。処理後は必ず元に戻す。
    • 対象指定: ThisWorkbook.Worksheets("名前")で「このブック」の該当シートを狙い撃ち。

安全テンプレート：存在チェック＋最後の1枚回避＋後始末保証

例外安全版（エラーでもDisplayAlerts復帰）

Sub SafeDeleteSheet_ByName(sheetName As String, Optional wb As Workbook)
    Dim wasAlertsOn As Boolean
    Dim ws As Worksheet

    If wb Is Nothing Then Set wb = ThisWorkbook
    wasAlertsOn = Application.DisplayAlerts '現在設定を退避

    '存在チェック
    On Error Resume Next
    Set ws = wb.Worksheets(sheetName)
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "シート『" & sheetName & "』は存在しません。削除をスキップします。"
        Exit Sub
    End If

    '最後の1枚を削除しようとしていないか
    If wb.Worksheets.Count <= 1 Then
        MsgBox "ブックには最低1枚のシートが必要です。削除できません。"
        Exit Sub
    End If

    '削除（警告をオフ）
    On Error GoTo FINALLY
    Application.DisplayAlerts = False
    ws.Delete

FINALLY:
    Application.DisplayAlerts = wasAlertsOn '必ず元の設定に戻す
    If Err.Number <> 0 Then
        MsgBox "削除中にエラーが発生しました: " & Err.Description
        Err.Clear
    End If
End Sub

Sub Example_SafeDelete()
    SafeDeleteSheet_ByName "一時シート" '名前を変えて試してみてください
End Sub
VB
  • ポイント:
    • 存在チェック: 見つからないときのエラーを防止し、メッセージで通知。
    • 最後の1枚回避: Excelはシートをゼロ枚にはできません。常に1枚は残す。
    • 後始末保証: 退避したDisplayAlertsに必ず戻す。エラーでも環境が壊れない。

応用：複数削除、部分一致削除、除外して一括削除

名前リストをまとめて削除（存在しなければスキップ）

Sub DeleteSheets_ByList(names As Variant, Optional wb As Workbook)
    Dim i As Long, ws As Worksheet

    If wb Is Nothing Then Set wb = ThisWorkbook
    If wb.Worksheets.Count <= 1 Then
        MsgBox "シートが1枚しかありません。削除できません。": Exit Sub
    End If

    Dim wasAlertsOn As Boolean: wasAlertsOn = Application.DisplayAlerts
    Application.DisplayAlerts = False

    On Error Resume Next
    For i = LBound(names) To UBound(names)
        Set ws = wb.Worksheets(CStr(names(i)))
        If Not ws Is Nothing Then
            If wb.Worksheets.Count > 1 Then ws.Delete
        End If
        Set ws = Nothing
    Next
    On Error GoTo 0

    Application.DisplayAlerts = wasAlertsOn
End Sub

Sub Example_DeleteList()
    DeleteSheets_ByList Array("下書き", "一時", "バックアップ")
End Sub
VB
  • ポイント:
    • 柔軟: 存在するものだけ削除。配列で複数指定。
    • 安全: ループ中も最後の1枚にならないように確認。

特定名以外をすべて削除（テンプレートだけ残す）

Sub DeleteAllExcept(keepNames As Variant, Optional wb As Workbook)
    Dim ws As Worksheet, keep As Object, name As Variant
    If wb Is Nothing Then Set wb = ThisWorkbook

    '残す名前をセット化
    Set keep = CreateObject("Scripting.Dictionary")
    For Each name In keepNames
        keep(CStr(name)) = True
    Next

    Dim wasAlertsOn As Boolean: wasAlertsOn = Application.DisplayAlerts
    Application.DisplayAlerts = False

    '後ろから削除すると安全（インデックスがずれない）
    Dim i As Long
    For i = wb.Worksheets.Count To 1 Step -1
        Set ws = wb.Worksheets(i)
        If Not keep.Exists(ws.Name) And wb.Worksheets.Count > 1 Then
            ws.Delete
        End If
    Next

    Application.DisplayAlerts = wasAlertsOn
End Sub

Sub Example_DeleteAllExcept()
    DeleteAllExcept Array("Template", "設定")
End Sub
VB
  • ポイント:
    • 除外削除: 指定した名前は残し、他は一掃。
    • 逆順ループ: インデックスのズレ防止に有効。

部分一致で削除（例：「一時」を含む名称）

Sub DeleteSheets_ByPartial(partial As String, Optional wb As Workbook)
    Dim ws As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook

    Dim wasAlertsOn As Boolean: wasAlertsOn = Application.DisplayAlerts
    Application.DisplayAlerts = False

    '逆順で走査して削除
    Dim i As Long
    For i = wb.Worksheets.Count To 1 Step -1
        Set ws = wb.Worksheets(i)
        If InStr(1, ws.Name, partial, vbTextCompare) > 0 Then
            If wb.Worksheets.Count > 1 Then ws.Delete
        End If
    Next

    Application.DisplayAlerts = wasAlertsOn
End Sub

Sub Example_DeletePartial()
    DeleteSheets_ByPartial "一時"
End Sub
VB
  • ポイント:
    • 大文字小文字無視: vbTextCompareで扱いやすく。
    • 命名揺れ対応: 一時・tmp・draftなどにも応用可能。

実務の落とし穴と対策

  • 後始末の徹底:
    • Application.DisplayAlertsは「アプリ全体」に効くため、必ず元に戻す。エラー時でも復帰する構造に。
  • 最後の1枚問題:
    • 必ず1枚残す: ブックをシート0枚にできない。削除前に残枚数を確認。
  • 参照の無効化:
    • 削除後の参照に注意: ActiveSheetや削除したwsを後続で参照するとエラー。削除前に必要情報を退避しておく。
  • 保護・非表示状態:
    • 保護解除が必要: シート保護中は削除不可。VeryHiddenでも削除は可能だが、存在チェックのために一覧化しておくと安心。
  • 対象の明確化:
    • ThisWorkbook vs ActiveWorkbook: マクロ格納ブックを確実に処理するならThisWorkbook。ユーザー操作中のブックならActiveWorkbook。

例題で練習

例題1：作業完了時に「一時」「下書き」系をまとめて削除

Sub Cleanup_Workbook()
    DeleteSheets_ByPartial "一時"
    DeleteSheets_ByPartial "下書き"
    DeleteSheets_ByList Array("tmp", "draft")
    MsgBox "作業用シートの削除が完了しました。"
End Sub
VB
  • ポイント:
    • 複数パターン併用: 部分一致と固定名の両方で確実に掃除。

例題2：テンプレートと設定だけ残してクリーン化

Sub ResetToTemplateOnly()
    DeleteAllExcept Array("Template", "設定")
    MsgBox "テンプレートと設定だけを残しました。"
End Sub
VB
  • ポイント:
    • 初期化運用: レポート生成後のリセットに便利。

次の一歩（小課題）

  • 課題1: InputBoxで受け取った語（例:「不要」）を部分一致削除関数に渡し、該当シートを一掃。
  • 課題2: 今日の日付を含む一時シート（例:「一時_2025-12-03」）のみ削除する「日付フィルタ」版を作る。
  • 課題3: 大量ブックを一括処理する前に、削除対象一覧を新規シートにログ出力してから削除する「確認付き」運用に拡張。

スポンサーリンク
タイトルとURLをコピーしました