〖ExcelVBA〗重複データをキー指定で比較・統合するマクロ｜同じ顧客・同じ商品を1行にまとめる

Excelでデータを扱っていると、次のような「重複行」をよく見かけます。

同じ顧客コードが何行もある（購買履歴・問い合わせ履歴など）
同じ商品コードが複数行に分かれている（入出庫・売上など）
名簿が複数ソースから集まって重複している

こういうとき、「キー（例：顧客ID）」で同じ行をまとめて、1行に統合できると便利です。
そこで今回は、キー列を指定して重複データを比較し、統合結果を別シートに出力するVBAを紹介します。

この記事でできること
想定するデータ例
重複データをキー指定で比較・統合するマクロ（コピペOK）
使い方（超シンプル）
カスタマイズ例
よくある注意点
まとめ：重複統合は“キー指定＋統合ルール”で自動化できる

この記事でできること

キー列（1つでも複数でもOK）で「同じデータ」を判定
同じキーの行を1行に統合して別シートへ出力
数値列は合計（例：数量、金額）
文字列列は結合（例：備考）
空白セルは、後の行の値で補完（例：住所が片方にしかない）

想定するデータ例

例：A列「顧客ID」をキーとして統合するイメージです。
シート名は「元データ」に変更しています。

重複データをキー指定で比較・統合するマクロ（コピペOK）

以下のコードを標準モジュールに貼り付けてください。
（Alt + F11 → 挿入 → 標準モジュール）

※ 設定欄（キー列・合計する列・結合する列）だけ、あなたの表に合わせて変更すれば使えます。

Option Explicit

Sub MergeDuplicatesByKey()

    Dim wsSrc As Worksheet
    Dim wsOut As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim r As Long, c As Long

    ' ====== ここだけ調整すればOK（設定欄） ======
    Set wsSrc = Worksheets("元データ")     ' 元データシート名

    ' キー列（複数指定OK：例 Array(1,2) なら A列+B列 をキーにする）
    Dim keyCols As Variant
    keyCols = Array(1)  ' 例：A列がキー

    ' 合計する列（数値列）
    Dim sumCols As Variant
    sumCols = Array(4)  ' 例：D列（購入金額）を合計

    ' 文字を結合する列（備考など）
    Dim concatCols As Variant
    concatCols = Array(5) ' 例：E列（備考）を結合

    ' 結合時の区切り文字
    Const CONCAT_SEP As String = " / "
    ' ===========================================

    ' 出力シートを作り直し
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("統合結果").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set wsOut = Worksheets.Add(After:=wsSrc)
    wsOut.Name = "統合結果"

    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
    lastCol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column

    ' 見出しコピー
    wsSrc.Range(wsSrc.Cells(1, 1), wsSrc.Cells(1, lastCol)).Copy
    wsOut.Cells(1, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    ' Dictionary（連想配列）を使用：キー → 出力行番号
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim outRow As Long
    outRow = 1

    For r = 2 To lastRow

        Dim key As String
        key = BuildKey(wsSrc, r, keyCols)

        If Len(key) = 0 Then
            ' キーが空の行はスキップ（必要ならここを変更）
            GoTo NextRow
        End If

        If Not dict.Exists(key) Then
            ' 新規キー：出力に新行を作って丸ごとコピー
            outRow = outRow + 1
            dict.Add key, outRow

            For c = 1 To lastCol
                wsOut.Cells(outRow, c).Value = wsSrc.Cells(r, c).Value
            Next c

        Else
            ' 既存キー：統合ルールに従って上書き・加算・結合
            Dim targetRow As Long
            targetRow = dict(key)

            ' 1) 空白補完（出力側が空で、元側に値があるなら埋める）
            For c = 1 To lastCol
                If Len(CStr(wsOut.Cells(targetRow, c).Value)) = 0 Then
                    If Len(CStr(wsSrc.Cells(r, c).Value)) > 0 Then
                        wsOut.Cells(targetRow, c).Value = wsSrc.Cells(r, c).Value
                    End If
                End If
            Next c

            ' 2) 数値列は合計
            Dim sc As Variant
            For Each sc In sumCols
                wsOut.Cells(targetRow, CLng(sc)).Value = _
                    Nz(wsOut.Cells(targetRow, CLng(sc)).Value) + Nz(wsSrc.Cells(r, CLng(sc)).Value)
            Next sc

            ' 3) 文字列列は重複しないように結合
            Dim cc As Variant
            For Each cc In concatCols
                wsOut.Cells(targetRow, CLng(cc)).Value = _
                    MergeTextUnique(CStr(wsOut.Cells(targetRow, CLng(cc)).Value), CStr(wsSrc.Cells(r, CLng(cc)).Value), CONCAT_SEP)
            Next cc

        End If

NextRow:
    Next r

    wsOut.Columns.AutoFit
    MsgBox "重複データの統合が完了しました。", vbInformation

End Sub

' キー列（複数）を結合してキー文字列を作る
Private Function BuildKey(ws As Worksheet, rowIndex As Long, keyCols As Variant) As String
    Dim i As Long
    Dim parts As String
    parts = ""

    For i = LBound(keyCols) To UBound(keyCols)
        Dim v As String
        v = Trim(CStr(ws.Cells(rowIndex, CLng(keyCols(i))).Value))
        parts = parts & "|" & v
    Next i

    BuildKey = parts
End Function

' 数値変換（空白や文字は 0 扱い）
Private Function Nz(v As Variant) As Double
    If IsNumeric(v) Then
        Nz = CDbl(v)
    Else
        Nz = 0
    End If
End Function

' 文字列を「重複しないように」結合する（既に含まれていたら追加しない）
Private Function MergeTextUnique(existingText As String, newText As String, sep As String) As String

    existingText = Trim(existingText)
    newText = Trim(newText)

    If Len(newText) = 0 Then
        MergeTextUnique = existingText
        Exit Function
    End If

    If Len(existingText) = 0 Then
        MergeTextUnique = newText
        Exit Function
    End If

    ' すでに含まれていれば追加しない
    If InStr(1, existingText, newText, vbTextCompare) > 0 Then
        MergeTextUnique = existingText
    Else
        MergeTextUnique = existingText & sep & newText
    End If

End Function

使い方（超シンプル）

元データを「元データ」シートに用意（1行目は見出し）
コードの設定欄で「キー列・合計列・結合列」を自分の表に合わせる
MergeDuplicatesByKey を実行
「統合結果」シートに統合されたデータが出力される

カスタマイズ例

① キーを複数にしたい（例：顧客ID + 日付）

keyCols = Array(1, 2)  ' A列とB列の組み合わせでキー化

② 合計する列を増やしたい（例：金額と数量）

sumCols = Array(4, 6)  ' D列とF列を合計

③ 結合する列を増やしたい（例：備考とタグ）

concatCols = Array(5, 7)

④ 「空白補完をしない」運用にしたい

コード内の「空白補完（1）」のブロックをコメントアウトすればOKです。

よくある注意点

キー列が空の行はスキップする仕様です（必要なら変更可能）
「数値として合計したい列」には、数値が入っていることが前提です
文字列結合は「含まれていれば追加しない」簡易判定なので、運用によって調整できます

まとめ：重複統合は“キー指定＋統合ルール”で自動化できる

重複データを1つずつ目視で確認して統合するのは、時間もかかりますしミスも起きやすいです。
今回のVBAを使えば、キーで比較して、合計・結合・空白補完まで自動で統合できます。

名簿の統合
売上データの集計
問い合わせ履歴のまとめ
入出庫データの整理

こうした作業が多い方は、ぜひ一度試してみてください。