Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 月次処理自動化

Excel VBA
スポンサーリンク

ねらい：月次の「集計→締め処理→レポート→ピボット→バックアップ」を一括で自動化する

月次処理は、日次の積み重ねを「月区切り」で確実に締めて出力することが命です。VBAなら“期間キーの決定→データ取り込み・正規化→集計・KPI作成→レポートとピボット→月次バックアップと版管理”の型にすると、誰が回しても同じ品質になります。初心者でも貼って動くテンプレを、例題付きでかみ砕いて解説します。

共通基盤：期間キー・設定・ログ・安全化

期間キーと設定ユーティリティ

' ModMonthly_Base.bas
Option Explicit

Public Type MonthlyConfig
    YearMonth As String   ' 例: "2025-12"
    SrcFolder As String   ' 月次元データの置き場所
    OutFolder As String   ' 月次レポート出力
    BackupFolder As String
    RoundMode As String   ' "round"/"ceil"/"floor"
End Type

Public Function LoadMonthlyConfig(ByVal year As Long, ByVal month As Long) As MonthlyConfig
    Dim c As MonthlyConfig
    c.YearMonth = Format(DateSerial(year, month, 1), "yyyy-mm")
    c.SrcFolder = ThisWorkbook.Path & "\monthly_in"
    c.OutFolder = ThisWorkbook.Path & "\monthly_out"
    c.BackupFolder = ThisWorkbook.Path & "\monthly_backup"
    c.RoundMode = "round"
    LoadMonthlyConfig = c
End Function

Public Function MonthStart(ByVal ym As String) As Date
    MonthStart = DateSerial(CLng(Left$(ym, 4)), CLng(Mid$(ym, 6, 2)), 1)
End Function

Public Function MonthEnd(ByVal ym As String) As Date
    Dim y As Long: y = CLng(Left$(ym, 4))
    Dim m As Long: m = CLng(Mid$(ym, 6, 2))
    MonthEnd = DateSerial(y, m + 1, 0) ' 当月末日
End Function

Public Function EnsureFolder(ByVal folderPath As String) As Boolean
    On Error Resume Next
    If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath
    EnsureFolder = (Dir(folderPath, vbDirectory) <> "")
    On Error GoTo 0
End Function

Public Sub AppendLog(ByVal logPath As String, ByVal message As String)
    Dim f As Integer: f = FreeFile
    Open logPath For Append As #f
    Print #f, Format(Now, "yyyy-mm-dd hh:nn:ss"); " | "; message
    Close #f
End Sub
VB

重要部分の深掘り

  • 月次キーは “yyyy-mm” を固定。開始日・終了日は関数化して誤差ゼロにします。
  • 設定値（フォルダ・丸め・対象月）は1箇所に集約。現場変更もこの関数だけ直せば十分です。
  • ログ出力は“時刻＋メッセージ”で追記。監査と失敗時の原因追跡が速くなります。

入口処理：ソース取り込みと整形（型変換・正規化）

取り込み・正規化テンプレ

' ModMonthly_ImportClean.bas
Option Explicit

Public Function ImportMonthlyCsv(ByVal csvPath As String) As Variant
    Dim wb As Workbook, ws As Worksheet
    Set wb = Application.Workbooks.Open(csvPath)
    Set ws = wb.Worksheets(1)
    ImportMonthlyCsv = ws.Range("A1").CurrentRegion.Value
    wb.Close SaveChanges:=False
End Function

Public Function ToNumberOrZero(ByVal v As Variant) As Double
    If IsNumeric(v) Then ToNumberOrZero = CDbl(v) Else ToNumberOrZero = 0#
End Function

Public Function ToDateOrEmpty(ByVal v As Variant) As Variant
    If IsDate(v) Then ToDateOrEmpty = CDate(v) Else ToDateOrEmpty = ""
End Function

Public Function NormKey(ByVal v As Variant) As String
    NormKey = LCase$(Trim$(CStr(v)))
End Function

Public Function CleanMonthly(ByVal a As Variant) As Variant
    ' 例の明細構成: A=注文日, B=顧客, C=商品, D=数量, E=金額
    Dim out() As Variant: ReDim out(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
    Dim lastCol As Long: lastCol = UBound(a, 2)
    Dim r As Long, c As Long

    For c = 1 To lastCol: out(1, c) = a(1, c): Next
    out(1, lastCol + 1) = "YearMonth"

    For r = 2 To UBound(a, 1)
        For c = 1 To lastCol: out(r, c) = a(r, c): Next
        out(r, 2) = NormKey(a(r, 2))         ' 顧客キー
        out(r, 3) = NormKey(a(r, 3))         ' 商品キー
        out(r, 4) = ToNumberOrZero(a(r, 4))  ' 数量
        out(r, 5) = ToNumberOrZero(a(r, 5))  ' 金額
        Dim dt As Variant: dt = ToDateOrEmpty(a(r, 1))
        out(r, lastCol + 1) = IIf(IsDate(dt), Format(CDate(dt), "yyyy-mm"), "")
    Next
    CleanMonthly = out
End Function
VB

重要部分の深掘り

  • 数値・日付・キーの正規化は入口で徹底。ここで失敗は安全値（0・空）に落とし、集計の破綻を防ぎます。
  • 年月派生列を付与すると、月次抽出がシンプルになり、ピボットの安定性も向上します。

集計とKPI：売上合計・件数・平均・達成率

グループ集計とKPI計算

' ModMonthly_Aggregate.bas
Option Explicit

Public Function FilterByYearMonth(ByVal a As Variant, ByVal ym As String) As Variant
    ' YearMonth列を最終列だと仮定
    Dim ymCol As Long: ymCol = UBound(a, 2)
    Dim r As Long, rows As Long: rows = 1
    Dim out() As Variant: ReDim out(1 To 1, 1 To UBound(a, 2))
    ' ヘッダ
    Dim c As Long: For c = 1 To UBound(a, 2): out(1, c) = a(1, c): Next
    For r = 2 To UBound(a, 1)
        If CStr(a(r, ymCol)) = ym Then
            rows = rows + 1: ReDim Preserve out(1 To rows, 1 To UBound(a, 2))
            For c = 1 To UBound(a, 2): out(rows, c) = a(r, c): Next
        End If
    Next
    FilterByYearMonth = out
End Function

Public Function GroupSum(ByVal a As Variant, ByVal keyCol As Long, ByVal valCol As Long, ByVal hKey As String, ByVal hSum As String) As Variant
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
    Dim r As Long
    For r = 2 To UBound(a, 1)
        Dim k As String: k = CStr(a(r, keyCol))
        Dim v As Double: v = ToNumberOrZero(a(r, valCol))
        d(k) = IIf(d.Exists(k), d(k) + v, v)
    Next
    Dim out() As Variant: ReDim out(1 To d.Count + 1, 1 To 2)
    out(1, 1) = hKey: out(1, 2) = hSum
    Dim i As Long: i = 2, key As Variant
    For Each key In d.Keys
        out(i, 1) = key
        out(i, 2) = d(key)
        i = i + 1
    Next
    GroupSum = out
End Function

Public Function GroupCountAvg(ByVal a As Variant, ByVal keyCol As Long, ByVal valCol As Long, ByVal hKey As String) As Variant
    Dim sumD As Object: Set sumD = CreateObject("Scripting.Dictionary"): sumD.CompareMode = 1
    Dim cntD As Object: Set cntD = CreateObject("Scripting.Dictionary"): cntD.CompareMode = 1
    Dim r As Long
    For r = 2 To UBound(a, 1)
        Dim k As String: k = CStr(a(r, keyCol))
        Dim v As Double: v = ToNumberOrZero(a(r, valCol))
        sumD(k) = IIf(sumD.Exists(k), sumD(k) + v, v)
        cntD(k) = IIf(cntD.Exists(k), cntD(k) + 1, 1)
    Next
    Dim out() As Variant: ReDim out(1 To sumD.Count + 1, 1 To 4)
    out(1, 1) = hKey: out(1, 2) = "Sum": out(1, 3) = "Count": out(1, 4) = "Avg"
    Dim i As Long: i = 2, key As Variant
    For Each key In sumD.Keys
        out(i, 1) = key
        out(i, 2) = sumD(key)
        out(i, 3) = cntD(key)
        out(i, 4) = IIf(cntD(key) > 0, sumD(key) / cntD(key), 0#)
        i = i + 1
    Next
    GroupCountAvg = out
End Function
VB

重要部分の深掘り

  • 月次フィルタで対象月だけに絞ってから、顧客別や商品別の合計・件数・平均を出します。
  • KPI（達成率や平均単価）は“分母ゼロ対策”が必須。0除算を避け、安定した値を返す設計にします。

レポートとピボット：見える化と更新の自動化

月次レポートの作成と書式

' ModMonthly_Report.bas
Option Explicit

Public Sub RenderMonthlyReport(ByVal monthData As Variant, ByVal outSheet As String)
    Dim ws As Worksheet
    On Error Resume Next: Set ws = Worksheets(outSheet): On Error GoTo 0
    If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = outSheet Else ws.Cells.Clear

    ' 顧客別 金額合計・件数・平均
    Dim custAgg As Variant: custAgg = GroupCountAvg(monthData, 2, 5, "Customer")
    WriteBlock ws, custAgg, "A1"

    ' 商品別 金額合計
    Dim prodSum As Variant: prodSum = GroupSum(monthData, 3, 5, "Product", "AmountSum")
    WriteBlock ws, prodSum, "E1"

    ' 書式
    With ws.Range("A1").CurrentRegion
        .Columns.AutoFit: .Borders.LineStyle = xlContinuous
        .Columns("B:D").NumberFormatLocal = "#,##0"
    End With
    With ws.Range("E1").CurrentRegion
        .Columns.AutoFit: .Borders.LineStyle = xlContinuous
        .Columns("F").NumberFormatLocal = "#,##0"
    End With
End Sub

Public Sub WriteBlock(ByVal ws As Worksheet, ByVal a As Variant, ByVal startAddr As String)
    ws.Range(startAddr).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub
VB

ピボット自動生成（商品×顧客の月次合計）

' ModMonthly_Pivot.bas
Option Explicit

Public Sub CreateMonthlyPivot(ByVal srcSheet As String, ByVal outSheet As String)
    Dim wsSrc As Worksheet: Set wsSrc = Worksheets(srcSheet)
    Dim srcRng As Range: Set srcRng = wsSrc.Range("A1").CurrentRegion

    Dim wsOut As Worksheet
    On Error Resume Next: Set wsOut = Worksheets(outSheet): On Error GoTo 0
    If wsOut Is Nothing Then Set wsOut = Worksheets.Add: wsOut.Name = outSheet Else wsOut.Cells.Clear

    Dim pc As PivotCache
    Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=srcRng)
    Dim pt As PivotTable
    Set pt = pc.CreatePivotTable(TableDestination:=wsOut.Range("A3"), TableName:="PivotMonthly")

    With pt
        .RowAxisLayout xlTabularRow
        .PivotFields("商品").Orientation = xlRowField
        .PivotFields("顧客").Orientation = xlColumnField
        With .PivotFields("金額")
            .Orientation = xlDataField
            .Function = xlSum
            .Name = "金額_合計"
            .NumberFormat = "#,##0"
        End With
    End With

    wsOut.Range("A1").Value = "月次ピボット（商品×顧客：金額合計）"
End Sub
VB

重要部分の深掘り

  • レポートは“配列→一括貼り→書式統一”。列の数値書式は“#,##0”に固定して視認性を確保します。
  • ピボットは行・列・値を“フィールド名で指定”。列順が変わっても壊れません。タブ形式で見出し繰り返しを有効化します。

バックアップと締め処理：版管理・PDF/CSV出力

月次バックアップ・エクスポート

' ModMonthly_Archive.bas
Option Explicit

Public Sub BackupWorkbookMonthly(ByVal ym As String, ByVal backupRoot As String, Optional ByVal keep As Long = 12)
    Dim folder As String: folder = backupRoot & "\Book"
    If Not EnsureFolder(backupRoot) Or Not EnsureFolder(folder) Then Exit Sub
    Dim path As String: path = folder & "\" & "Monthly_" & Replace(ym, "-", "") & ".xlsx"
    Application.DisplayAlerts = False
    ThisWorkbook.SaveCopyAs path
    Application.DisplayAlerts = True
    RotateByCount folder, ".xlsx", keep
End Sub

Private Sub RotateByCount(ByVal folder As String, ByVal ext As String, ByVal keep As Long)
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim fl As Object: Set fl = fso.GetFolder(folder).Files
    Dim list As New Collection, fi As Object
    For Each fi In fl
        If LCase$(Right$(fi.Name, Len(ext))) = LCase$(ext) Then list.Add fi
    Next
    If list.Count <= keep Then Exit Sub
    ' 作成日時で古い順に削除
    Dim i As Long, j As Long, tmp As Object
    For i = 1 To list.Count - 1
        For j = i + 1 To list.Count
            If list(i).DateCreated > list(j).DateCreated Then
                Set tmp = list(i): Set list(i) = list(j): Set list(j) = tmp
            End If
        Next
    Next
    For i = 1 To list.Count - keep
        On Error Resume Next: list(i).Delete True: On Error GoTo 0
    Next
End Sub

Public Sub ExportMonthlyReport(ByVal ws As Worksheet, ByVal ym As String, ByVal outFolder As String)
    If Not EnsureFolder(outFolder) Then Exit Sub
    Dim csvPath As String: csvPath = outFolder & "\report_" & Replace(ym, "-", "") & ".csv"
    Dim pdfPath As String: pdfPath = outFolder & "\report_" & Replace(ym, "-", "") & ".pdf"

    ' CSV
    Dim tempWB As Workbook: Set tempWB = Application.Workbooks.Add
    ws.Range("A1").CurrentRegion.Copy
    tempWB.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    tempWB.SaveAs Filename:=csvPath, FileFormat:=xlCSVUTF8
    Application.DisplayAlerts = True
    tempWB.Close False

    ' PDF
    With ws.PageSetup
        .Orientation = xlPortrait: .Zoom = False
        .FitToPagesWide = 1: .FitToPagesTall = 1
        .LeftMargin = Application.CentimetersToPoints(1)
        .RightMargin = Application.CentimetersToPoints(1)
        .TopMargin = Application.CentimetersToPoints(1)
        .BottomMargin = Application.CentimetersToPoints(1)
    End With
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, OpenAfterPublish:=False
End Sub
VB

重要部分の深掘り

  • 月次バックアップは“年月でファイル名固定＋12世代保持”が定番。年単位でローテーションすると運用が楽です。
  • CSVは“値貼り付け＋UTF-8”、PDFは印刷設定をコードで固定。毎月同じ見た目を保ちます。

月次パイプライン例：対象月指定→取り込み→整形→集計→レポート→ピボット→バックアップ

一括実行テンプレ（貼って動く）

' ModMonthly_Pipeline.bas
Option Explicit

Public Sub Run_MonthlyProcess(ByVal year As Long, ByVal month As Long)
    Dim cfg As MonthlyConfig: cfg = LoadMonthlyConfig(year, month)
    If Not EnsureFolder(cfg.SrcFolder) Or Not EnsureFolder(cfg.OutFolder) Or Not EnsureFolder(cfg.BackupFolder) Then
        MsgBox "フォルダ準備に失敗しました。", vbExclamation: Exit Sub
    End If
    Dim logPath As String: logPath = cfg.BackupFolder & "\monthly_" & Replace(cfg.YearMonth, "-", "") & ".log"

    On Error GoTo FAIL
    AppendLog logPath, "START: " & cfg.YearMonth

    ' 1) 入口：CSV取り込み
    Dim csvPath As String: csvPath = cfg.SrcFolder & "\detail_" & Replace(cfg.YearMonth, "-", "") & ".csv"
    AppendLog logPath, "IMPORT: " & csvPath
    Dim raw As Variant: raw = ImportMonthlyCsv(csvPath)

    ' 2) 整形
    AppendLog logPath, "CLEAN"
    Dim cleaned As Variant: cleaned = CleanMonthly(raw)

    ' 3) 月次抽出
    AppendLog logPath, "FILTER"
    Dim monthData As Variant: monthData = FilterByYearMonth(cleaned, cfg.YearMonth)

    ' 4) レポート出力
    AppendLog logPath, "REPORT"
    RenderMonthlyReport monthData, "Monthly_Report"

    ' 5) ピボット作成
    AppendLog logPath, "PIVOT"
    CreateMonthlyPivot "Monthly_Report", "Monthly_Pivot"

    ' 6) エクスポート
    AppendLog logPath, "EXPORT"
    ExportMonthlyReport Worksheets("Monthly_Report"), cfg.YearMonth, cfg.OutFolder

    ' 7) バックアップ
    AppendLog logPath, "BACKUP"
    BackupWorkbookMonthly cfg.YearMonth, cfg.BackupFolder, 12

    AppendLog logPath, "OK"
    MsgBox "月次処理（" & cfg.YearMonth & "）が完了しました。", vbInformation
    Exit Sub

FAIL:
    AppendLog logPath, "FAILED: " & Err.Number & " - " & Err.Description
    MsgBox "月次処理でエラーが発生しました（ログ参照）", vbExclamation
End Sub
VB

期待動作の確認ポイント

  • 対象月のCSVが取り込まれ、正規化・月次抽出の後に顧客／商品別のレポートが生成。
  • ピボットが作られ、CSV／PDFが出力され、12世代のバックアップが管理されます。
  • ログに各工程の開始・成功が記録され、失敗時は内容が残ります。

落とし穴と対策（深掘り）

年月の指定ミスやファイル欠損

“detail_yyyymm.csv”命名規則を固定し、存在しない場合は直ちにログ記録して停止します。次工程へ進めないのが安全です。

文字数値・テキスト日付で平均・合計が崩れる

入口で ToNumberOrZero／ToDateOrEmpty を通し、失敗は安全値へ落とす設計を徹底します。

グループ列の揺らぎで月次抽出漏れ

YearMonthは明細内で派生・固定。文字列“yyyy-mm”で持つと比較が安定し、ピボット列にも使いやすいです。

出力書式のふらつき

数値書式“#,##0”と罫線・AutoFitを標準化して適用。レビュー性が飛躍的に上がります。

版管理の誤削除

12世代保持のローテーションは作成日時で厳格に制御。初期は保持数を多めに設定して運用の癖を掴みます。

まとめ：期間キー→正規化→集計→見える化→バックアップの型で、月次を“同じ品質”にする

対象月をキーで決め、入口で揺らぎを潰し、顧客・商品のKPIを一撃で作成。ピボットと書式で見える化し、CSV・PDF・バックアップまで自動化すれば、毎月の締めが短時間で、再現性高く行えます。

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