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

Excel VBA
スポンサーリンク

ねらい：毎朝の「取り込み→整形→集計→レポート→バックアップ」を“同じ手順”で一括自動化する

日次処理は、手順がブレるとすぐに品質が落ちます。VBAなら「入口でデータを正す→集計・出力→配布物作成→バックアップ→ログ記録→失敗時は止めずに通知」の型にすれば、誰が回しても同じ結果が出ます。初心者でも貼って動くテンプレを、例題付きでかみ砕いて解説します。

共通基盤：設定・ログ・安全トライキャッチ

設定値とログユーティリティ

' ModDaily_Base.bas
Option Explicit

Public Type DailyConfig
    SrcFolder As String   ' 取り込み元フォルダ
    OutFolder As String   ' 出力フォルダ（レポート・CSV）
    BackupFolder As String
    DateKey As String     ' 日次キー（yyyy-mm-dd）
    RoundMode As String   ' 金額の丸め "round"/"ceil"/"floor"
End Type

Public Function LoadConfig() As DailyConfig
    Dim c As DailyConfig
    c.SrcFolder = ThisWorkbook.Path & "\inbox"
    c.OutFolder = ThisWorkbook.Path & "\outbox"
    c.BackupFolder = ThisWorkbook.Path & "\backup"
    c.DateKey = Format(Date, "yyyy-mm-dd")
    c.RoundMode = "round"
    LoadConfig = c
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

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 SafeMsg(ByVal text As String)
    On Error Resume Next
    MsgBox text, vbInformation
    On Error GoTo 0
End Sub
VB

重要ポイントの深掘り

  • 設定は1箇所（LoadConfig）に集約。パスや日付キー、丸め方法を毎日同じ値で使い回せます。
  • ログは「日時 | メッセージ」で追記。監査・失敗時のトレースが容易になります。
  • フォルダ生成は必ず“存在チェック→作成”に統一。突然のパス変更でも壊れません。

入口処理：CSV取り込み→型変換→正規化

取り込みとクリーニング（貼って動く）

' ModDaily_ImportClean.bas
Option Explicit

Public Function ImportCsvToArray(ByVal csvPath As String) As Variant
    Dim wb As Workbook, ws As Worksheet
    Set wb = Application.Workbooks.Open(csvPath)
    Set ws = wb.Worksheets(1)
    ImportCsvToArray = 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 CleanDaily(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

    ' ヘッダ＋派生列（YearMonth）
    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
    CleanDaily = out
End Function
VB

重要ポイントの深掘り

  • 入口で“数値・日付・キー正規化”を徹底。これだけで集計の多くの事故（文字数値・テキスト日付・グループ割れ）を防げます。
  • 年月派生（yyyy-mm）を明細に加えると、月次ピボットやグラフが安定します。
  • CSVは開いてCurrentRegionで一括取得→閉じる。貼り付けではなく配列で扱うのが高速・堅牢です。

集計とレポート：顧客別／商品別／日次・月次

グループ合計テンプレ

' ModDaily_Aggregate.bas
Option Explicit

Public Function GroupSum(ByVal a As Variant, ByVal keyCol As Long, ByVal valueCol As Long, ByVal headerKey As String, ByVal headerSum 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, valueCol))
        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) = headerKey: out(1, 2) = headerSum
    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 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
    With ws.Range(startAddr).CurrentRegion
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
        .Columns(.Columns.Count).NumberFormatLocal = "#,##0"
    End With
End Sub
VB

見える化レポート作成（貼って動く）

' ModDaily_Report.bas
Option Explicit

Public Sub BuildDailyReport(ByVal cleaned 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 byCust As Variant: byCust = GroupSum(cleaned, 2, 5, "Customer", "AmountSum")
    WriteBlock ws, byCust, "A1"

    ' 商品別合計（金額）
    Dim byProd As Variant: byProd = GroupSum(cleaned, 3, 5, "Product", "AmountSum")
    WriteBlock ws, byProd, "D1"

    ' 月次合計（金額）
    Dim byMon As Variant: byMon = GroupSum(cleaned, UBound(cleaned, 2), 5, "Month", "AmountSum")
    WriteBlock ws, byMon, "G1"

    ' 簡易グラフ（任意）
    Dim rng As Range: Set rng = ws.Range("G1").CurrentRegion
    Dim ch As ChartObject: Set ch = ws.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top + rng.Height + 10, Width:=400, Height:=240)
    ch.Chart.ChartType = xlColumnClustered
    ch.Chart.SetSourceData rng
    ch.Chart.HasTitle = True
    ch.Chart.ChartTitle.Text = "Monthly Amount"
End Sub
VB

重要ポイントの深掘り

  • GroupSumは“キー列・値列・ヘッダ名”だけで汎用に使えます。顧客・商品・月次の切替も一瞬。
  • 出力は「セル一括貼り→書式一括適用」。千区切りと罫線を標準化し、レビューが速くなります。
  • グラフは最小構成でOK。見出しだけ付けて、位置も自動配置にすると崩れません。

配布とバックアップ：CSV/PDF出力・世代管理

CSV出力・PDF化・バックアップ呼び出し

' ModDaily_Distribute.bas
Option Explicit

Public Sub ExportReportCsv(ByVal ws As Worksheet, ByVal startAddr As String, ByVal csvPath As String)
    Dim tempWB As Workbook: Set tempWB = Application.Workbooks.Add
    ws.Range(startAddr).CurrentRegion.Copy
    tempWB.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    tempWB.SaveAs Filename:=csvPath, FileFormat:=xlCSVUTF8
    Application.DisplayAlerts = True
    tempWB.Close False
End Sub

Public Sub ExportSheetPdf(ByVal ws As Worksheet, ByVal pdfPath As String)
    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

重要ポイントの深掘り

  • CSVは“値貼り付け＋UTF-8”で文字化けを防止。関数のまま保存しないのが鉄則です。
  • PDFは印刷設定をコードで固定。毎日同じ見た目で出力され、配布を標準化できます。
  • バックアップは「日次フォルダに時刻スタンプ名」でローテーション。版数管理は週次・月次で切ると運用しやすいです。

日次パイプライン：取込→整形→集計→配布→バックアップ→ログ

例題の一括実行（貼って動く）

' ModDaily_Pipeline.bas
Option Explicit

Public Sub Run_DailyProcess()
    Dim cfg As DailyConfig: cfg = LoadConfig()
    If Not EnsureFolder(cfg.SrcFolder) Then SafeMsg "取り込みフォルダなし: " & cfg.SrcFolder
    If Not EnsureFolder(cfg.OutFolder) Then SafeMsg "出力フォルダ作成失敗: " & cfg.OutFolder
    If Not EnsureFolder(cfg.BackupFolder) Then SafeMsg "バックアップフォルダ作成失敗: " & cfg.BackupFolder

    Dim logPath As String: logPath = cfg.BackupFolder & "\daily_" & Replace(cfg.DateKey, "-", "") & ".log"
    On Error GoTo FAIL

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

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

    ' 3) レポート生成
    AppendLog logPath, "REPORT"
    Call BuildDailyReport(cleaned, "Daily_Report")

    ' 4) 配布物出力（CSV/PDF）
    AppendLog logPath, "EXPORT CSV/PDF"
    ExportReportCsv Worksheets("Daily_Report"), "A1", cfg.OutFolder & "\report_" & Replace(cfg.DateKey, "-", "") & ".csv"
    ExportSheetPdf Worksheets("Daily_Report"), cfg.OutFolder & "\report_" & Replace(cfg.DateKey, "-", "") & ".pdf"

    ' 5) バックアップ（ブック丸ごと）
    AppendLog logPath, "BACKUP"
    Call BackupWorkbook(ThisWorkbook, cfg.BackupFolder, 7)

    AppendLog logPath, "OK"
    SafeMsg "日次処理が完了しました。"
    Exit Sub

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

重要ポイントの深掘り

  • 失敗しても“ログに残して通知”して終えるのが正解。無理に続行しない。
  • ファイル名は“日付キー”で固定すると、差し替え時も迷いません。
  • 出力先（CSV/PDF/バックアップ）はフォルダで分離。運用導線がスッキリします。

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

テキスト日付・文字数値で集計が壊れる

入口で ToDateOrEmpty／ToNumberOrZero を通す。失敗は安全値（空・0）に落とす方針を固定。

取り込みファイルの欠損・命名ズレ

“detail_yyyymmdd.csv”の命名規則を固定。見つからない場合は即ログ化＋通知で止める。

出力書式のふらつき

NumberFormatLocal “#,##0”＋罫線＋AutoFit を標準化。毎日同じ見た目で比較・監査を可能に。

セル逐次書きで遅い

配列→一括貼り付けが鉄則。10万行でも短時間で完了し、画面が固まりません。

フォルダ権限・共有切断

EnsureFolder で事前検証。共有先へ直接書かず、まずローカルに保存→成功後に共有へ同期の二段構えを検討。

まとめ：手順を“型”にし、設定・ログ・失敗時の導線まで含めて日次を強くする

  • 設定は一箇所、入口で整える、集計は汎用関数、出力はCSV/PDFで固定、バックアップとログを必ず残す。
  • 失敗時は止めずにログ化・通知。翌日の修正が速くなります。
  • あなたの明細列（日付・顧客・商品・数量・金額の位置）、命名規則、必要なレポート（顧客別・商品別・月次・グラフ）を教えてください。現場仕様に合わせて“貼って動く”日次処理テンプレに最短で仕立てます。
スポンサーリンク
タイトルとURLをコピーしました