DeleteEmptySheets

' DeleteEmptySheets
' -----------------
' Macro Name: DeleteEmptySheets
' Description: 空のシート（一括でデータがないシート）を削除する
' Parameters: なし
' Returns: なし
' Usage: 実行すると空のシートがリストされ、確認後に削除される
' -----------------

Sub DeleteEmptySheets()
    Dim ws As Worksheet
    Dim emptySheets As Collection
    Dim sheetName As String
    Dim confirmMsg As String
    Dim i As Long
    Dim keepAtLeastOne As Boolean

    On Error GoTo ErrorHandler

    Set emptySheets = New Collection

    For Each ws In Worksheets
        If IsSheetEmpty(ws) Then
            emptySheets.Add ws.Name
        End If
    Next ws

    If emptySheets.Count = 0 Then
        MsgBox "空のシートはありません。", vbInformation
        Exit Sub
    End If

    confirmMsg = "以下の空シートを削除します:" & vbCrLf & vbCrLf
    For i = 1 To emptySheets.Count
        confirmMsg = confirmMsg & "  " & i & ": " & emptySheets(i) & vbCrLf
    Next i
    confirmMsg = confirmMsg & vbCrLf & "宜しいですか？"

    If Worksheets.Count - emptySheets.Count < 1 Then
        MsgBox "すべてのシートが空白です。全削除は禁止されています。", vbExclamation
        Exit Sub
    End If

    If MsgBox(confirmMsg, vbYesNo + vbExclamation, "空シート削除") = vbNo Then
        Exit Sub
    End If

    Application.DisplayAlerts = False

    For i = emptySheets.Count To 1 Step -1
        Worksheets(emptySheets(i)).Delete
    Next i

    Application.DisplayAlerts = True

    MsgBox emptySheets.Count & "枚の空シートを削除しました。", vbInformation
    Exit Sub

ErrorHandler:
    Application.DisplayAlerts = True
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

Private Function IsSheetEmpty(ws As Worksheet) As Boolean
    Dim usedRange As Range

    Set usedRange = ws.UsedRange

    If usedRange Is Nothing Then
        IsSheetEmpty = True
        Exit Function
    End If

    If Application.WorksheetFunction.CountA(usedRange) = 0 Then
        IsSheetEmpty = True
    Else
        IsSheetEmpty = False
    End If
End Function