162_データをクロス集計に変換する方法

この記事でできること

月次の売上データを「担当者×商品カテゴリ」のクロス集計表にまとめる作業があった。毎月500行の明細を見ながら、Excelのセルに1つずつ数字を転記していた。正直めんどくさかったし、転記ミスが怖くて何度も確認していた。

VBAで自動化してからは、マクロを実行するだけで明細データが行見出し×列見出しのクロス集計表（マトリックス表）に変換される。手作業で1時間かかっていた集計が数秒で終わるようになった。

この記事で、同じように明細データからクロス集計表を作る作業に時間を取られている人が、サクッと自動化できるようになればうれしい。

• 対象：明細データからクロス集計表を手作業で作っている人、VBAが初めての人
• 所要時間：コピペ → 実行まで約5分（目安）

クロス集計はピボットテーブルでも作成できる。ピボットテーブルをVBAで自動生成する方法は 【VBA】ピボットテーブルをVBAで自動生成する方法 で解説している。「コードで自由にレイアウトを制御したい」「ピボットテーブルの操作が苦手」という場合は、本記事のDictionary方式がおすすめ。

—

どんな場面で使う？

• 売上明細から「担当者×商品カテゴリ」のクロス集計表を自動で作りたいとき
• ピボットテーブルを使わずにコードでレイアウトを完全制御した集計表を生成したいとき
• 毎月同じ形式のクロス集計表を定型レポートとして自動出力したいとき
• 明細データの行見出し×列見出しの集計表を報告書として配布したいとき

完成イメージ（Before / After）

Before（実行前）– 明細データ（Sheet1）

After（実行後）– クロス集計表（Sheet2「クロス集計」）

行見出し（担当者）×列見出し（カテゴリ）で、売上金額が自動集計される。

—

実行前の準備

バックアップを取る

対象のExcelファイルをコピーしてバックアップを取ること。クロス集計の出力先シートは上書きされるため、既存データがある場合は消える。

Excelをマクロ有効ブック（.xlsm）で保存する

1. 対象のExcelファイルを開く
2. 「ファイル」→「名前を付けて保存」
3. ファイルの種類を 「Excel マクロ有効ブック (*.xlsm)」 に変更して保存

.xlsx のままだとマクロが保存されない。必ず .xlsm にすること。

—

手順（コピペ → 実行まで約5分）

VBE（コードを書く画面）を開く

Alt + F11 キーを押すとVBE（Visual Basic Editor）が開く。

企業のセキュリティ設定でVBAが無効化されている場合は、IT部門に確認すること。

標準モジュールを挿入する

1. VBEのメニュー「挿入」→「標準モジュール」をクリック
2. 右側に白い画面（コードウィンドウ）が表示される

コードを貼り付けて実行する

1. 下の「コード（最小版）」をコピーして、コードウィンドウに貼り付ける
2. コード内の列番号（ROW_COL, COL_COL, VAL_COL）を自分のデータに合わせて書き換える
3. Alt + F8 を押す
4. 「CrossTabulate」を選択して「実行」
5. 「クロス集計」シートにマトリックス表が出力される

—

コード（最小版）– Dictionary2重ループでクロス集計

まずはこれだけで動く。明細データの「行見出し列」「列見出し列」「集計値列」を指定すると、クロス集計表を別シートに出力する。

Sub CrossTabulate()

    Dim wsData As Worksheet
    Dim wsOut As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' --- ★ ここを自分のデータに合わせて変更 ---
    Const ROW_COL As Long = 1   ' 行見出しの列番号（A列=1）
    Const COL_COL As Long = 2   ' 列見出しの列番号（B列=2）
    Const VAL_COL As Long = 3   ' 集計値の列番号（C列=3）
    Const DATA_START As Long = 2 ' データ開始行（見出し行の次）

    ' 明細データのシート
    Set wsData = ThisWorkbook.Sheets(1)

    ' 出力先シートを準備（既存なら削除して再作成）
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets("クロス集計").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set wsOut = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsOut.Name = "クロス集計"

    ' データの最終行を取得
    lastRow = wsData.Cells(wsData.Rows.Count, ROW_COL).End(xlUp).Row

    ' Dictionary で行見出し・列見出しを収集
    Dim dictRow As Object
    Dim dictCol As Object
    Set dictRow = CreateObject("Scripting.Dictionary")
    Set dictCol = CreateObject("Scripting.Dictionary")

    For i = DATA_START To lastRow
        Dim rowKey As String
        Dim colKey As String
        rowKey = CStr(wsData.Cells(i, ROW_COL).Value)
        colKey = CStr(wsData.Cells(i, COL_COL).Value)

        If rowKey <> "" And Not dictRow.Exists(rowKey) Then
            dictRow.Add rowKey, dictRow.Count + 1
        End If
        If colKey <> "" And Not dictCol.Exists(colKey) Then
            dictCol.Add colKey, dictCol.Count + 1
        End If
    Next i

    ' 見出しを出力
    Dim rowKeys As Variant
    Dim colKeys As Variant
    rowKeys = dictRow.Keys
    colKeys = dictCol.Keys

    Dim r As Long, c As Long

    ' 列見出し（1行目のB列以降）
    For c = 0 To UBound(colKeys)
        wsOut.Cells(1, c + 2).Value = colKeys(c)
    Next c

    ' 行見出し（2行目以降のA列）
    For r = 0 To UBound(rowKeys)
        wsOut.Cells(r + 2, 1).Value = rowKeys(r)
    Next r

    ' 集計値を加算
    For i = DATA_START To lastRow
        rowKey = CStr(wsData.Cells(i, ROW_COL).Value)
        colKey = CStr(wsData.Cells(i, COL_COL).Value)

        If rowKey <> "" And colKey <> "" Then
            r = dictRow(rowKey) + 1  ' +1 は見出し行のオフセット
            c = dictCol(colKey) + 1  ' +1 は見出し列のオフセット

            wsOut.Cells(r, c).Value = wsOut.Cells(r, c).Value + wsData.Cells(i, VAL_COL).Value
        End If
    Next i

    wsOut.Columns.AutoFit

    MsgBox "クロス集計が完了しました。" & vbCrLf & _
           "行見出し：" & dictRow.Count & " 件" & vbCrLf & _
           "列見出し：" & dictCol.Count & " 件", vbInformation

End Sub

コードの動作：

1. 明細データの行見出し列・列見出し列から、ユニークな値をDictionaryで収集
2. 出力先シート「クロス集計」に行見出し×列見出しの枠を作成
3. 明細データをループし、該当するセルに値を加算
4. 列幅を自動調整して完了

列番号の設定： ROW_COL = 1（A列が行見出し）、COL_COL = 2（B列が列見出し）、VAL_COL = 3（C列が集計値）の部分を自分のデータ構成に合わせて書き換える。

—

コード（実務版）– 複数集計値＋合計行列＋書式設定

業務で使うなら、合計行・合計列がほしい、数値に桁区切りを入れたい、見出しに色を付けたい、という要望がある。複数の集計値列にも対応した実務版。

Dictionaryの基本的な使い方（Exists、Keys/Items）は 【VBA】Dictionaryで重複チェック・集計を高速化する方法 で詳しく解説している。

自分はこの実務版を使い始めてから、月次報告書の集計作業がボタン1つで終わるようになった。上司に「今月も早いね」と言われるようになって、もっと早く知りたかったと思った。

Sub CrossTabulateEx()

    Dim wsData As Worksheet
    Dim wsOut As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' --- ★ ここを自分のデータに合わせて変更 ---
    Const ROW_COL As Long = 1    ' 行見出しの列番号（A列=1）
    Const COL_COL As Long = 2    ' 列見出しの列番号（B列=2）
    Const VAL_COL As Long = 3    ' 集計値の列番号（C列=3）
    Const DATA_START As Long = 2 ' データ開始行（見出し行の次）
    Const SHEET_NAME As String = "クロス集計"

    ' 画面更新・再計算を停止（高速化）
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' 明細データのシート
    Set wsData = ThisWorkbook.Sheets(1)

    ' 出力先シートを準備（既存なら削除して再作成）
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Sheets(SHEET_NAME).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set wsOut = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsOut.Name = SHEET_NAME

    ' データの最終行を取得
    lastRow = wsData.Cells(wsData.Rows.Count, ROW_COL).End(xlUp).Row

    If lastRow < DATA_START Then
        MsgBox "明細データが見つかりません。", vbExclamation
        GoTo CleanUp
    End If

    ' Dictionary で行見出し・列見出しを収集
    Dim dictRow As Object
    Dim dictCol As Object
    Set dictRow = CreateObject("Scripting.Dictionary")
    Set dictCol = CreateObject("Scripting.Dictionary")

    For i = DATA_START To lastRow
        Dim rowKey As String
        Dim colKey As String
        rowKey = CStr(wsData.Cells(i, ROW_COL).Value)
        colKey = CStr(wsData.Cells(i, COL_COL).Value)

        If rowKey <> "" And Not dictRow.Exists(rowKey) Then
            dictRow.Add rowKey, dictRow.Count + 1
        End If
        If colKey <> "" And Not dictCol.Exists(colKey) Then
            dictCol.Add colKey, dictCol.Count + 1
        End If
    Next i

    Dim rowCount As Long
    Dim colCount As Long
    rowCount = dictRow.Count
    colCount = dictCol.Count

    ' 見出しを出力
    Dim rowKeys As Variant
    Dim colKeys As Variant
    rowKeys = dictRow.Keys
    colKeys = dictCol.Keys

    Dim r As Long, c As Long

    ' 左上セル（ラベル）
    wsOut.Cells(1, 1).Value = wsData.Cells(1, ROW_COL).Value & " \ " & wsData.Cells(1, COL_COL).Value

    ' 列見出し（1行目のB列以降）
    For c = 0 To UBound(colKeys)
        wsOut.Cells(1, c + 2).Value = colKeys(c)
    Next c
    ' ここが追加：合計列の見出し
    wsOut.Cells(1, colCount + 2).Value = "合計"

    ' 行見出し（2行目以降のA列）
    For r = 0 To UBound(rowKeys)
        wsOut.Cells(r + 2, 1).Value = rowKeys(r)
    Next r
    ' ここが追加：合計行の見出し
    wsOut.Cells(rowCount + 2, 1).Value = "合計"

    ' 集計値を加算
    For i = DATA_START To lastRow
        rowKey = CStr(wsData.Cells(i, ROW_COL).Value)
        colKey = CStr(wsData.Cells(i, COL_COL).Value)

        If rowKey <> "" And colKey <> "" Then
            r = dictRow(rowKey) + 1
            c = dictCol(colKey) + 1

            Dim val As Variant
            val = wsData.Cells(i, VAL_COL).Value
            If IsNumeric(val) Then
                wsOut.Cells(r, c).Value = wsOut.Cells(r, c).Value + CDbl(val)
            End If
        End If
    Next i

    ' ここが追加：合計行（各列の合計）
    For c = 2 To colCount + 1
        Dim colTotal As Double
        colTotal = 0
        For r = 2 To rowCount + 1
            colTotal = colTotal + wsOut.Cells(r, c).Value
        Next r
        wsOut.Cells(rowCount + 2, c).Value = colTotal
    Next c

    ' ここが追加：合計列（各行の合計）
    For r = 2 To rowCount + 2  ' 合計行も含む
        Dim rowTotal As Double
        rowTotal = 0
        For c = 2 To colCount + 1
            rowTotal = rowTotal + wsOut.Cells(r, c).Value
        Next c
        wsOut.Cells(r, colCount + 2).Value = rowTotal
    Next r

    ' ここが追加：書式設定
    ' 数値に桁区切り
    wsOut.Range(wsOut.Cells(2, 2), wsOut.Cells(rowCount + 2, colCount + 2)).NumberFormat = "#,##0"

    ' 見出し行の背景色（濃い青＋白文字）
    With wsOut.Range(wsOut.Cells(1, 1), wsOut.Cells(1, colCount + 2))
        .Interior.Color = RGB(68, 114, 196)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With

    ' 見出し列の背景色（薄い青）
    With wsOut.Range(wsOut.Cells(2, 1), wsOut.Cells(rowCount + 2, 1))
        .Interior.Color = RGB(217, 225, 242)
        .Font.Bold = True
    End With

    ' 合計行の背景色（薄い黄色）
    With wsOut.Range(wsOut.Cells(rowCount + 2, 1), wsOut.Cells(rowCount + 2, colCount + 2))
        .Interior.Color = RGB(255, 255, 204)
        .Font.Bold = True
    End With

    ' 合計列の背景色（薄い黄色）
    With wsOut.Range(wsOut.Cells(2, colCount + 2), wsOut.Cells(rowCount + 2, colCount + 2))
        .Interior.Color = RGB(255, 255, 204)
        .Font.Bold = True
    End With

    ' 罫線
    With wsOut.Range(wsOut.Cells(1, 1), wsOut.Cells(rowCount + 2, colCount + 2))
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
    End With

    wsOut.Columns.AutoFit

    MsgBox "クロス集計が完了しました。" & vbCrLf & _
           "行見出し：" & rowCount & " 件" & vbCrLf & _
           "列見出し：" & colCount & " 件" & vbCrLf & _
           "合計行・合計列を追加済み", vbInformation

CleanUp:
    ' 画面更新・再計算を再開
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

追加ポイント：

• 合計行・合計列を自動追加（右端と下端に「合計」が付く）
• 数値に桁区切り（#,##0）を適用
• 見出し行・列に背景色＋太字で見やすく整形
• 罫線を自動設定
• IsNumeric チェックで数値以外のデータが混入してもエラーにならない
• ScreenUpdating と Calculation をオフにして高速化（エラー時も復帰する CleanUp ラベル付き）

注意： 出力先の「クロス集計」シートは毎回削除して再作成される。前回の集計結果を残したい場合は、シート名を変更してから再実行すること。

—

よくある落とし穴5選

自分が最初にクロス集計マクロを作ったとき、行見出しに空白行があることに気づかなかった。結果、空白が1つの見出しとして集計表に出てきてしまい、上司に「この空行は何？」と聞かれて焦った。空白セルのスキップ処理は必ず入れておくべき。

VBAのクロス集計で同じ見出しが別々に集計されるときの対処法

「食品」と「食品 」のように見出しが分かれてしまう場合、見出しの前後にスペースや改行が含まれていてDictionaryが別キーとして認識していることが原因だ。Trim()で前後のスペースを除去してからDictionaryに登録しよう。全角スペースが混在している場合はReplace()でも除去する。

VBAのクロス集計で数値が集計されないときの対処法

「集計結果が0になる」場合、元データの数値列がテキスト形式で格納されていて加算処理がスキップされている可能性が高い。IsNumeric()で判定してからCDbl()で数値に変換して加算しよう。CSVインポート後は数値列の書式が「文字列」になっていないか確認すること。

—

FAQ

Q1: 集計方法を「合計」以外（件数・平均）にしたい

件数の場合は、値の加算部分を wsOut.Cells(r, c).Value = wsOut.Cells(r, c).Value + 1 に変更する。平均の場合は、合計と件数を別々に集計して、最後に割り算する。Dictionaryをもう1つ用意して件数を管理するのが手軽な方法。

Q2: 行見出しを並べ替えたい

Dictionaryは登録順に値を返すため、並び順は明細データの出現順になる。五十音順や数値順にしたい場合は、見出しを配列に取り出してからソートし、出力時にその順序を使う。並べ替えの方法は 【VBA】データを複数条件で自動並び替えする方法 が参考になる。

Q3: ピボットテーブルとの使い分けは？

ピボットテーブルはGUIで操作でき、フィルタやドリルダウンが簡単。一方、VBAのDictionary方式は出力レイアウトを完全にコード制御できる。「毎月同じ形式の報告書を自動生成したい」「ピボットテーブルを触らせたくない相手に配布する」場合はVBA方式が向いている。ピボットテーブルのVBA自動生成は 【VBA】ピボットテーブルをVBAで自動生成する方法 を参照。

Q4: 明細データが複数シートに分かれている場合は？

複数シートをループして、同じDictionaryに追加していけば統合クロス集計ができる。複数シートのループ処理は 【VBA】複数シートに同じ処理を一括実行する方法 を参照。

Q5: クロス集計の結果をフィルタで絞り込みたい

出力された集計表に対してオートフィルタを適用すれば絞り込める。フィルタ操作の自動化は 【VBA】複数条件でデータを抽出して別シートにまとめる方法 で解説している。

—

まとめ

この記事で、明細データからクロス集計表（マトリックス表）を自動生成できるようになった。

• 最小版：Dictionary2重ループで行見出し×列見出しのクロス集計表を出力
• 実務版：合計行・合計列＋桁区切り＋見出し色＋罫線で報告書レベルの仕上がり

重要なのは、Dictionaryで見出しを収集してからセルに書き出すこと。ループ中に直接セルを操作すると処理が遅くなる。大量データの場合は配列と組み合わせるのが定石。

関連記事

• 【VBA】ピボットテーブルをVBAで自動生成する方法 — ピボットテーブルでクロス集計を作りたい場合。GUI操作との使い分けがわかる
• 【VBA】データの行と列を入れ替える（転置する）方法 — クロス集計表の行列を入れ替えたい場合に使える
• 【VBA】Dictionaryで重複チェック・集計を高速化する方法 — 本記事で使ったDictionaryの基本が学べる
• 【VBA】複数条件でデータを抽出して別シートにまとめる方法 — 集計前に明細データを絞り込みたい場合に便利
• 【VBA】罫線を一括で引く・消す・種類を変える方法 — クロス集計表の罫線をカスタマイズしたい場合

次にやりたくなること

• 【VBA】ExcelファイルをPDFに一括変換する方法 — クロス集計表を報告書としてPDF化して配布したい場合はこちら
• 【VBA】Excelからメール自動作成（Outlook連携）する方法 — 集計結果をメールで自動送信したい場合はこちら
• 【VBA】データ範囲からグラフを自動作成する方法 — クロス集計表からグラフを自動で作りたい場合はこちら
• 【VBA】データを複数条件で自動並び替えする方法 — 集計表の見出しを五十音順や数値順に並べたい場合はこちら
• 【VBA】Dictionaryで重複チェック・集計を高速化する方法 — Dictionaryの基本操作を深掘りしたい場合はこちら

—

もっとカスタマイズしたい場合

「複数の集計値（金額と件数）を同時に出したい」「月別×担当者×商品の3軸クロスにしたい」「集計表を自動でグラフ化したい」など、業務に合わせたカスタマイズが必要な場合は、ココナラで相談できます。

相談時に以下の情報があるとスムーズです：

• Excel のバージョン / OS
• 明細データの構成（列名・行数の目安）
• 行見出し・列見出し・集計値の列
• 出力形式の希望（合計・件数・平均、書式、グラフなど）

—

—

セルフチェック

• [x] 再現性：前提条件 → 貼り付け → 列番号変更 → 実行 → 結果確認の流れが書かれている
• [x] 安全性：バックアップ推奨あり。出力先シートの上書き警告あり
• [x] 落とし穴が5つある
• [x] FAQが5つある
• [x] コードがコピペで動く（列番号の書き換えのみ）
• [x] 「次にやりたくなること」セクションに内部リンクが2本以上ある
• [x] 機密情報なし（担当者名・商品名はダミー）
• [x] 断定なし（前提条件を明記）
• [x] 筆者体験が導入（共感：500行の売上データ転記）と落とし穴（空白行の見出し化）に入っている
• [x] 内部リンクが合計10本以上ある（058, 063, 050, 021, 036, 068, 015, 040, 009, 007）