サマリーレポート生成
「明細データをまとめて、レポート用のサマリー表を自動生成したい」——そんな場面に使えるテンプレを初心者向けに整理しました。合計・件数・平均を部署別や月次別にまとめ、見やすいレポートを別シートに出力する方法です。
選び方の指針
- 最短: SUMIFS/COUNTIFS/AVERAGEIFSで部署や月ごとに集計して表へ
- 大量・柔軟: 配列＋辞書で「キー→指標」を一括集計（爆速）
- 見た目重視: ピボットテーブルでサマリー表を一発生成
- レポート仕上げ: ヘッダー・書式・総合計を自動追加
基本テンプレ：部署別サマリーを別シートに出力
Sub CreateSummary_ByDept()
'明細：A=部署, B=日付, C=金額
Dim rg As Range: Set rg = Range("A1").CurrentRegion
Dim v As Variant: v = rg.Value
Dim sumMap As Object: Set sumMap = CreateObject("Scripting.Dictionary")
Dim cntMap As Object: Set cntMap = CreateObject("Scripting.Dictionary")
Dim i As Long, dept As String
For i = 2 To UBound(v, 1)
dept = Trim$(CStr(v(i, 1)))
If sumMap.Exists(dept) Then
sumMap(dept) = sumMap(dept) + Val(v(i, 3))
cntMap(dept) = cntMap(dept) + 1
Else
sumMap.Add dept, Val(v(i, 3))
cntMap.Add dept, 1
End If
Next
'出力シート
Dim wsO As Worksheet
On Error Resume Next
Set wsO = Worksheets("サマリー")
If wsO Is Nothing Then
Set wsO = Worksheets.Add: wsO.Name = "サマリー"
End If
On Error GoTo 0
wsO.Cells.Clear
wsO.Range("A1:C1").Value = Array("部署", "合計", "平均")
Dim rOut As Long: rOut = 2
Dim k As Variant
For Each k In sumMap.Keys
wsO.Cells(rOut, 1).Value = k
wsO.Cells(rOut, 2).Value = sumMap(k)
wsO.Cells(rOut, 3).Value = sumMap(k) / cntMap(k)
rOut = rOut + 1
Next
End Sub
- ポイント
- 部署ごとに合計・平均を出力。
- 件数も必要なら列を追加。
- シート「サマリー」を自動作成。
月次サマリー（年月ごとに集計）
Sub CreateSummary_ByMonth()
'明細：A=日付, B=部署, C=金額
Dim rg As Range: Set rg = Range("A1").CurrentRegion
Dim v As Variant: v = rg.Value
Dim sumMap As Object: Set sumMap = CreateObject("Scripting.Dictionary")
Dim i As Long, ym As String
For i = 2 To UBound(v, 1)
ym = Format$(v(i, 1), "yyyy-mm") '年月キー
If sumMap.Exists(ym) Then
sumMap(ym) = sumMap(ym) + Val(v(i, 3))
Else
sumMap.Add ym, Val(v(i, 3))
End If
Next
Dim wsO As Worksheet
On Error Resume Next
Set wsO = Worksheets("月次サマリー")
If wsO Is Nothing Then
Set wsO = Worksheets.Add: wsO.Name = "月次サマリー"
End If
On Error GoTo 0
wsO.Cells.Clear
wsO.Range("A1:B1").Value = Array("年月", "合計")
Dim rOut As Long: rOut = 2
Dim k As Variant
For Each k In sumMap.Keys
wsO.Cells(rOut, 1).Value = k
wsO.Cells(rOut, 2).Value = sumMap(k)
rOut = rOut + 1
Next
End Sub
- ポイント
- 年月キーを作って集計。
- 部署×年月にしたい場合はキーを
"部署|yyyy-mm"に。
ピボットでサマリーレポートを一発生成
Sub CreateSummary_Pivot()
Dim src As Range: Set src = Range("A1").CurrentRegion 'A=部署, B=日付, C=金額
Dim wsO As Worksheet
On Error Resume Next
Set wsO = Worksheets("ピボットサマリー")
If wsO Is Nothing Then
Set wsO = Worksheets.Add: wsO.Name = "ピボットサマリー"
End If
On Error GoTo 0
Dim pc As PivotCache, pt As PivotTable
Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, src)
Set pt = pc.CreatePivotTable(wsO.Range("A3"), "サマリーPT")
With pt
.PivotFields("部署").Orientation = xlRowField
.PivotFields("日付").Orientation = xlColumnField
.PivotFields("日付").NumberFormat = "yyyy-mm"
With .PivotFields("金額")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
End With
End With
End Sub
- ポイント
- 行＝部署、列＝年月、値＝金額合計。
- 見た目が強い: 小計・総計も自動で出る。
レポート仕上げの工夫
- ヘッダー行を太字・背景色:
wsO.Range("A1:C1").Font.Bold = True
wsO.Range("A1:C1").Interior.Color = RGB(200, 200, 200)
- 列幅自動調整:
wsO.Columns.AutoFit
- 総合計行を追加:
wsO.Cells(rOut, 1).Value = "総合計"
wsO.Cells(rOut, 2).Formula = "=SUM(B2:B" & rOut - 1 & ")"
よくある落とし穴と対策
- 日付に時刻が入っていて月次集計が崩れる
→Format$(DateValue(日付), "yyyy-mm")で年月に丸める。 - 部署名の表記揺れで別集計になる
→Trim/UCaseで正規化。必要なら置換表を事前適用。 - 列順変更で壊れる
→ 見出し名から列番号をFindで取得して安全に参照。 - セル往復で遅い
→ 範囲→配列→辞書→一括書き戻しが鉄板。
例題で練習
'例1：部署別に合計・平均をサマリーシートへ
Sub Example_DeptSummary()
Call CreateSummary_ByDept
End Sub
'例2：年月ごとに合計を月次サマリーシートへ
Sub Example_MonthSummary()
Call CreateSummary_ByMonth
End Sub
'例3：ピボットで部署×年月のサマリー表を作成
Sub Example_PivotSummary()
Call CreateSummary_Pivot
End Sub