Excel VBA 逆引き集 | 実務テンプレ完全版（超再利用部品） – 売上レポートツール

Excel VBA
スポンサーリンク

ねらい：売上明細から「整形→集計→ダッシュボード→ピボット→配布」まで一括で自動化する

売上レポートは「入口で正す→指標を作る→見える化→配布」を毎回同じ型で回すほど強くなります。VBAなら“配列I/O＋正規化＋汎用集計＋一括書式＋PDF/CSV出力”で、列変更にも壊れず、10万行でも短時間で完了します。初心者でも貼って動くテンプレを、例題付きでかみ砕いて解説します。

入力仕様と共通基盤（配列I/O・正規化・安全変換）

シート構成と列の意味

  • Data（売上明細）: A=注文日, B=顧客, C=商品, D=数量, E=単価, F=税区分（課税/非課税/軽減）, G=注文ID
  • Master（任意）: 商品・顧客のカテゴリなど（例：商品→カテゴリ、顧客→エリア）

明細は「縦持ち」「1行目ヘッダ」を厳守します。日付・数量・単価は“数値・日付”として扱えることが重要です。

ユーティリティ（貼って動く最小セット）

' ModSales_Base.bas
Option Explicit

Public Function ReadRegion(ws As Worksheet, Optional topLeft As String = "A1") As Variant
    ReadRegion = ws.Range(topLeft).CurrentRegion.Value
End Function

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

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

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

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

Public Sub FormatBlock(ws As Worksheet, startCell As String, Optional numberColsCsv As String = "")
    With ws.Range(startCell).CurrentRegion
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
    If Len(numberColsCsv) > 0 Then
        Dim cols() As String: cols = Split(numberColsCsv, ",")
        Dim i As Long
        For i = LBound(cols) To UBound(cols)
            ws.Columns(Trim$(cols(i))).NumberFormatLocal = "#,##0"
        Next
    End If
End Sub

Public Function TaxRate(ByVal taxType As String) As Double
    Select Case NormKey(taxType)
        Case "課税": TaxRate = 0.1
        Case "軽減": TaxRate = 0.08
        Case Else:   TaxRate = 0#
    End Select
End Function
VB

重要ポイントの深掘り

入口で「キー正規化」「数値・日付の確定」を徹底すると、集計の破綻（文字数値・テキスト日付・グループ割れ）を激減できます。表示書式は“#,##0”に統一し、レビュー性を標準化します。税率は税区分から関数で決定し、混在明細でも安全に合算できます。

整形と派生列（売上金額・税額・税込・年月・カテゴリ）

明細のクリーニングと派生列付与

' ModSales_Clean.bas
Option Explicit

' Data: A=注文日, B=顧客, C=商品, D=数量, E=単価, F=税区分, G=注文ID
' 出力列追加: YearMonth, Amount(税抜), Tax, Gross(税込)
Public Sub CleanSales(ByVal sheetName As String, ByVal outStart As String)
    Dim ws As Worksheet: Set ws = Worksheets(sheetName)
    Dim a As Variant: a = ReadRegion(ws)
    Dim lastCol As Long: lastCol = UBound(a, 2)

    Dim out() As Variant: ReDim out(1 To UBound(a, 1), 1 To lastCol + 4)
    Dim c As Long: For c = 1 To lastCol: out(1, c) = a(1, c): Next
    out(1, lastCol + 1) = "YearMonth"
    out(1, lastCol + 2) = "Amount"
    out(1, lastCol + 3) = "Tax"
    out(1, lastCol + 4) = "Gross"

    Dim r As Long
    For r = 2 To UBound(a, 1)
        For c = 1 To lastCol: out(r, c) = a(r, c): Next

        Dim qty As Double: qty = ToNumberOrZero(a(r, 4))
        Dim price As Double: price = ToNumberOrZero(a(r, 5))
        Dim tRate As Double: tRate = TaxRate(CStr(a(r, 6)))
        Dim amt As Double: amt = qty * price
        Dim tax As Double: tax = amt * tRate
        Dim gross As Double: gross = amt + tax

        out(r, lastCol + 2) = amt
        out(r, lastCol + 3) = tax
        out(r, lastCol + 4) = gross

        Dim dt As Variant: dt = ToDateOrEmpty(a(r, 1))
        out(r, lastCol + 1) = IIf(IsDate(dt), Format(CDate(dt), "yyyy-mm"), "")
        out(r, 2) = NormKey(a(r, 2)) ' 顧客キー正規化
        out(r, 3) = NormKey(a(r, 3)) ' 商品キー正規化
    Next

    WriteBlock ws, out, outStart
    FormatBlock ws, outStart, "D,E," & ColumnLetter(ws.Range(outStart).Column + lastCol + 2) & "," & ColumnLetter(ws.Range(outStart).Column + lastCol + 3) & "," & ColumnLetter(ws.Range(outStart).Column + lastCol + 4)
End Sub

Private Function ColumnLetter(ByVal col As Long) As String
    ColumnLetter = Split(Cells(1, col).Address(True, False), "$")(0)
End Function
VB

重要ポイントの深掘り

売上は「数量×単価」を税抜で持ち、税区分から税額を算出、税込を派生に。税の丸めは原則“合算後に丸め”が安全（端数差の拡大を防ぐため）。年月列（yyyy-mm）を持つと、月次集計・グラフが安定します。

集計テンプレ（顧客別・商品別・月次・カテゴリ別）

汎用グループ合計と複合KPI

' ModSales_Aggregate.bas
Option Explicit

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 GroupSumCountAvg(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
    GroupSumCountAvg = out
End Function
VB

レポート生成（見出し・書式・簡易チャート）

' ModSales_Report.bas
Option Explicit

Public Sub BuildSalesReport(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 = GroupSumCountAvg(cleaned, 2, UBound(cleaned, 2), "Customer") ' Gross(最後列)
    WriteBlock ws, byCust, "A1": With ws.Range("A1").CurrentRegion: .Columns.AutoFit: .Borders.LineStyle = xlContinuous: .Columns("B:D").NumberFormatLocal = "#,##0": End With

    ' 商品別（税込）
    Dim byProd As Variant: byProd = GroupSum(cleaned, 3, UBound(cleaned, 2), "Product", "GrossSum")
    WriteBlock ws, byProd, "F1": With ws.Range("F1").CurrentRegion: .Columns.AutoFit: .Borders.LineStyle = xlContinuous: .Columns("G").NumberFormatLocal = "#,##0": End With

    ' 月次（税込）
    Dim ymCol As Long: ymCol = UBound(cleaned, 2) - 3 ' YearMonth位置（Amount,Tax,Grossの3列前）
    Dim byMonth As Variant: byMonth = GroupSum(cleaned, ymCol, UBound(cleaned, 2), "Month", "GrossSum")
    WriteBlock ws, byMonth, "I1": With ws.Range("I1").CurrentRegion: .Columns.AutoFit: .Borders.LineStyle = xlContinuous: .Columns("J").NumberFormatLocal = "#,##0": End With

    ' 簡易チャート（売上の月次棒グラフ）
    Dim rng As Range: Set rng = ws.Range("I1").CurrentRegion
    Dim ch As ChartObject: Set ch = ws.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top + rng.Height + 10, Width:=480, Height:=260)
    With ch.Chart
        .ChartType = xlColumnClustered
        .SetSourceData rng
        .HasTitle = True: .ChartTitle.Text = "Monthly Gross Sales"
    End With
End Sub
VB

重要ポイントの深掘り

顧客・商品・月次の3軸を“汎用関数”で作ると、列変更に強く、使い回しが効きます。Avgは“Sum/Count（分母ゼロ回避）”で安定化。チャートは最小構成・固定サイズで崩れにくく設計します。

ピボット・フィルター・PDF/CSV出力（配布導線の標準化）

ピボット自動生成（商品×月の税込合計）

' ModSales_Pivot.bas
Option Explicit

Public Sub CreateSalesPivot(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(xlDatabase, srcRng)
    Dim pt As PivotTable: Set pt = pc.CreatePivotTable(TableDestination:=wsOut.Range("A3"), TableName:="SalesPivot")

    With pt
        .RowAxisLayout xlTabularRow
        .PivotFields("商品").Orientation = xlRowField
        .PivotFields("YearMonth").Orientation = xlColumnField
        With .PivotFields("Gross")
            .Orientation = xlDataField
            .Function = xlSum
            .Name = "税込合計"
            .NumberFormat = "#,##0"
        End With
    End With

    wsOut.Range("A1").Value = "商品 × 月（税込合計）"
End Sub
VB

配布物出力（CSV/UTF-8・PDF）

' ModSales_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は印刷設定を固定して毎回同じ見た目にします。

例題の通し方：整形→レポート→ピボット→配布→一括実行

パイプライン実行テンプレ（貼って動く）

' ModSales_Example.bas
Option Explicit

Public Sub Run_SalesPipeline()
    ' 1) 整形（派生列: YearMonth/Amount/Tax/Gross）
    CleanSales "Data", "Z1"

    ' 2) レポート生成（顧客・商品・月次）
    Dim cleaned As Variant: cleaned = Worksheets("Data").Range("Z1").CurrentRegion.Value
    BuildSalesReport cleaned, "Sales_Report"

    ' 3) ピボット（商品×月 税込合計）
    CreateSalesPivot "Data", "Sales_Pivot"

    ' 4) 配布（CSV/PDF）
    ExportReportCsv Worksheets("Sales_Report"), "A1", ThisWorkbook.Path & "\sales_report.csv"
    ExportSheetPdf Worksheets("Sales_Report"), ThisWorkbook.Path & "\sales_report.pdf"

    MsgBox "売上レポートツールの自動生成が完了しました。", vbInformation
End Sub
VB

期待動作の確認ポイント

Dataから派生列が追加され、Z1開始の整形データが生成。Sales_Reportに顧客・商品・月次の指標が出力され、Sales_Pivotに商品×月の税込合計ピボットが作られます。CSVとPDFが所定フォルダへ出力されます。

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

税の丸め位置・順序のブレで合計が合わない

「明細税額合算→丸め→税込合計」へ固定。行単位丸めは端数差が増えるため、まずは合算後の丸めが安全。

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

入口で ToDateOrEmpty／ToNumberOrZero を通し、失敗は0や空に落とす。取り込み後すぐに正規化するのが鉄則。

フィールド名変更でコードがエラー

フィールドは文字名で指定し、ヘッダ名を運用で固定。変更時は引数・指定名だけ差し替える設計に。

書式のふらつき・見づらさ

“#,##0”＋罫線＋AutoFitを一括適用。チャートは固定サイズ・タイトルのみで崩れにくく。

セル逐次書きで遅い

配列で結果を作り、一括書き戻し。10万行でも短時間で完了し、UIが固まりません。

まとめ：入口で正し、指標を一撃で作り、見える化と配布まで形にする

売上レポートは「正規化→派生列（税抜・税額・税込・年月）→汎用集計→ピボット→CSV/PDF」を型にすると、誰が回しても同じ品質に。

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