🍉

マクロ実施前月名のシートを残してシートを削除する処理

に公開

はじめに

マクロ実施前月名のシートを残してシートを削除する処理を実装しました。

実装したソースコード

実装したソースコードは以下です。

'マクロファイルの前月以外のシート削除処理
'新規作成 2025/8/14

Sub delete_last_year_macro_sheet()
    'メッセージアラートをOFFにする
    Application.DisplayAlerts = False
    'マクロファイルのwb1変数の定義
    Dim wb1 As Workbook
    'ws1変数の定義
    Dim ws1 As Worksheet
    'シート名変数の定義
    Dim sheet_name As String
    '開始シート番号の変数定義
    Dim start_num As Long
    '最終シート番号の変数定義
    Dim last_num As Long
    'カウント変数
    Dim i As Long
    'マクロ実施年変数の取得
    Dim work_year As Long
    'マクロ実施月変数の取得
    Dim work_month As Long
    
    
    'シート削除除外シート名変数の定義
    Dim except_sheet_name As String
    
    'wb1変数をセット
    Set wb1 = ThisWorkbook
    '開始シート番号変数をセット
    start_num = 1
    '最終シート番号をセット
    last_num = wb1.Sheets.Count
    '開始シート番号をカウント変数にセット
    i = start_num
    'マクロ実行年度を西暦で取得する
    work_year = Year(Date)
    work_month = Month(Date)
    work_month = work_month - 1
    
    '先月が0の時、前年の12月に変換する
    If work_month = 0 Then
        work_month = 12
        work_year = work_year - 1
    End If
    
    '除外シート文字列をセットする。
    except_sheet_name = CStr(work_year) & "0" & CStr(work_month)
    
    
    'カウント変数が、最終シート番号までループする
    While i <= last_num
        Set ws1 = wb1.Worksheets(i)
        'シート名を取得する
        sheet_name = ws1.Name
       'シート名が作業年前月シートの時は削除せず、カウント変数iを1加算する。
        If sheet_name = except_sheet_name Then
            i = i + 1
        Else
            ws1.Delete
                
        End If
        
        '最終シート番号を取得する
        last_num = wb1.Sheets.Count
        
    Wend
    'マクロファイルを保存する
    wb1.Save

End Sub

マクロ実行前のシートの状態

マクロ実行前のシートは下記の画像のとおりです。

マクロ実行後のシートの状態

マクロ実行後のシートは下記の画像のとおりです。

最後に

作成しているツールのテストを兼ねて実装しました。

Discussion