【Excel VBA】複数のシートの値を削除するマクロ

業務効率化
スポンサーリンク
Sub ClearSpecificSheets()
    Dim wsRecords As Worksheet
    Dim wsLog As Worksheet
    Dim wsCSV As Worksheet
    
    On Error Resume Next
    Set wsRecords = ThisWorkbook.Sheets("すべてのレコード")
    Set wsLog = ThisWorkbook.Sheets("ログ")
    Set wsCSV = ThisWorkbook.Sheets("CSVファイル")
    On Error GoTo 0
    
    ' シートが存在しない場合は警告を出してスキップ
    If wsRecords Is Nothing Then
        MsgBox "シート『すべてのレコード』が見つかりません。", vbExclamation
    Else
        wsRecords.Range("A2:N" & wsRecords.Rows.Count).ClearContents
    End If
    
    If wsLog Is Nothing Then
        MsgBox "シート『ログ』が見つかりません。", vbExclamation
    Else
        wsLog.Range("A2:C" & wsLog.Rows.Count).ClearContents
    End If
    
    If wsCSV Is Nothing Then
        MsgBox "シート『CSVファイル』が見つかりません。", vbExclamation
    Else
        wsCSV.Range("A2:F" & wsCSV.Rows.Count).ClearContents
    End If
    
    MsgBox "指定範囲の値を削除しました。", vbInformation
End Sub

今後もシートが増える予定

Sub ClearMultipleSheets()
    Dim targets As Variant
    Dim i As Long
    Dim ws As Worksheet
    Dim sheetName As String
    Dim rangeRef As String
    
    ' === 削除対象をここでまとめて定義 ===
    ' 書式: {{"シート名", "範囲"}, {"シート名", "範囲"}, ...}
    targets = Array( _
        Array("すべてのレコード", "A2:N"), _
        Array("ログ", "A2:C"), _
        Array("CSVファイル", "A2:F") _
    )
    
    ' === ループ処理 ===
    For i = LBound(targets) To UBound(targets)
        sheetName = targets(i)(0)
        rangeRef = targets(i)(1)
        
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0
        
        If ws Is Nothing Then
            MsgBox "シート『" & sheetName & "』が見つかりません。", vbExclamation
        Else
            ws.Range(rangeRef & ws.Rows.Count).ClearContents
        End If
        
        Set ws = Nothing
    Next i
    
    MsgBox "指定されたシートの値を削除しました。", vbInformation
End Sub