Excel VBA 逆引き集 | 2列以上の重複

Excel VBA
スポンサーリンク

2列以上の重複

「コード×日付」「部門×担当者」など、複数列の組み合わせで“同じ”かどうかを判定して、見える化・一覧出力・削除候補・安全削除までを一気にまとめました。初心者向けに、貼ってすぐ使えるテンプレです。

基本の考え方

  • 複合キー: 対象列を連結して一意のキーにする（例: 「コード|yyyy-mm-dd」）。
  • 正規化: 前後空白、大小文字、日付フォーマットをそろえると誤判定が減る。
  • 安全運用: まずは一覧化→色で確認→承認→下から削除。

共通ユーティリティ（速度・正規化・出力）

Option Explicit

Private Sub SpeedOn()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

Private Sub SpeedOff()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Function NormText(ByVal v As Variant) As String
    NormText = UCase$(Trim$(CStr(v)))
End Function

Private Function NormDateText(ByVal v As Variant) As String
    If IsDate(v) Then
        NormDateText = Format$(CDate(v), "yyyy-mm-dd")
    Else
        NormDateText = UCase$(Trim$(CStr(v)))
    End If
End Function

Private Function EnsureSheet(ByVal name As String, Optional ByVal clear As Boolean = True) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(name)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = name
    End If
    If clear Then ws.Cells.Clear
    Set EnsureSheet = ws
End Function
VB
  • ポイント: 速度最適化はON/OFFがセット。日付はyyyy-mm-ddに統一。

複合キーの作り方（2列・3列）

'2列複合キー：コード×日付
Private Function Key2(ByVal v1 As Variant, ByVal v2 As Variant) As String
    Key2 = NormText(v1) & "|" & NormDateText(v2)
End Function

'3列複合キー：部門×コード×枝番
Private Function Key3(ByVal v1 As Variant, ByVal v2 As Variant, ByVal v3 As Variant) As String
    Key3 = NormText(v1) & "|" & NormText(v2) & "|" & NormText(v3)
End Function
VB
  • 区切り文字: 「|」が安全。値内で使われにくく誤分割が起きにくい。

2列以上の重複を一覧出力（候補抽出）

「Data」シートで、A=コード、B=日付を例に、重複キーの行番号を一覧化します。

Sub ListDuplicates_TwoColumns()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
    Dim pos As Object: Set pos = CreateObject("Scripting.Dictionary")

    Dim r As Long, k As String
    For r = 2 To lastRow
        k = Key2(ws.Cells(r, "A").Value, ws.Cells(r, "B").Value)
        If InStr(k, "|") = 0 Then GoTo cont       ' どちらか空ならスキップ
        If seen.Exists(k) Then
            pos(k) = pos(k) & "," & r
        Else
            seen(k) = True
            pos(k) = CStr(r)
        End If
cont:
    Next

    Dim out As Worksheet: Set out = EnsureSheet("重複一覧(2列)", True)
    out.Range("A1:D1").Value = Array("コード", "日付", "出現回数", "行番号一覧")

    Dim i As Long: i = 2
    Dim key As Variant
    For Each key In pos.Keys
        Dim arrPos() As String: arrPos = Split(pos(key), ",")
        If UBound(arrPos) >= 1 Then
            Dim parts() As String: parts = Split(CStr(key), "|")
            out.Cells(i, 1).Value = parts(0)
            out.Cells(i, 2).Value = parts(1)
            out.Cells(i, 3).Value = UBound(arrPos) + 1
            out.Cells(i, 4).Value = pos(key)
            i = i + 1
        End If
    Next

    out.Columns.AutoFit
    SpeedOff
    MsgBox "2列以上の重複一覧を作成しました（件数: " & i - 2 & "）"
End Sub
VB
  • 使い方: 候補一覧で確認→承認後に削除へ進めると安全。

3列複合キーの重複をハイライト

「部門×コード×枝番」で重複行を淡黄色に塗ります。

Sub HighlightDuplicates_ThreeColumns()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ws.Range("A2:C" & lastRow).Interior.ColorIndex = xlNone

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
    Dim r As Long, k As String
    For r = 2 To lastRow
        k = Key3(ws.Cells(r, "A").Value, ws.Cells(r, "B").Value, ws.Cells(r, "C").Value)
        If InStr(k, "|") = 0 Then GoTo cont
        If seen.Exists(k) Then
            ws.Range("A" & r & ":C" & r).Interior.Color = RGB(255, 245, 180)
            Dim firstRow As Long: firstRow = CLng(Split(seen(k), "|")(0)) '初回行番号も塗る（任意）
            ws.Range("A" & firstRow & ":C" & firstRow).Interior.Color = RGB(255, 245, 180)
        Else
            seen(k) = r & "|" '初回行保持
        End If
cont:
    Next

    SpeedOff
    MsgBox "3列複合キーの重複をハイライトしました"
End Sub
VB
  • 見える化: 削除前に“どこが重複か”を現場で合意しやすい。

重複の安全削除（2列以上、先頭を残す）

一覧化せずに、2列キーで“2回目以降”を削除します。必ず“下から”削除。

Sub RemoveDuplicates_TwoColumns_Safe()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
    Dim delRows As Collection: Set delRows = New Collection

    Dim r As Long, k As String
    For r = 2 To lastRow
        k = Key2(ws.Cells(r, "A").Value, ws.Cells(r, "B").Value)
        If InStr(k, "|") = 0 Then GoTo cont
        If seen.Exists(k) Then
            delRows.Add r
        Else
            seen(k) = True
        End If
cont:
    Next

    Dim i As Long
    For i = delRows.Count To 1 Step -1
        ws.Rows(delRows(i)).Delete
    Next

    SpeedOff
    MsgBox "2列複合キーの重複削除完了: " & delRows.Count & "行（先頭を残す）"
End Sub
VB
  • 鉄則: 上から削除は行ズレの原因。必ず“下から”。

標準機能で一撃（RemoveDuplicates：複数列）

見出しありの表なら、標準機能でも複数列重複の削除が可能です。

Sub RemoveDuplicates_BuiltIn_Multi()
    SpeedOn
    With Worksheets("Data").Range("A1").CurrentRegion
        ' A列とB列を複合キーとして重複削除（先にある行を残す）
        .RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    End With
    SpeedOff
    MsgBox "標準機能で複数列の重複を削除しました（先頭を残す）"
End Sub
VB
  • メリット: 超簡単・超高速。列が確定しているならこれが最短。
  • 注意: “先頭を残す”挙動。最新優先などのルールは別テンプレで。

区分ごとに複数列重複を処理（部門ごとにコード×日付）

「部門ごとにコード×日付の重複を除去（先頭を残す）」の例です。

Sub RemoveDuplicates_ByGroup_MultiKey()
    SpeedOn

    Dim ws As Worksheet: Set ws = Worksheets("Data")
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim seen As Object: Set seen = CreateObject("Scripting.Dictionary")
    Dim delRows As Collection: Set delRows = New Collection

    Dim r As Long, grp As String, k As String, comp As String
    For r = 2 To lastRow
        grp = NormText(ws.Cells(r, "A").Value)                        '部門
        comp = Key2(ws.Cells(r, "B").Value, ws.Cells(r, "C").Value)   'コード×日付
        If Len(grp) = 0 Or InStr(comp, "|") = 0 Then GoTo cont
        k = grp & "|" & comp
        If seen.Exists(k) Then
            delRows.Add r
        Else
            seen(k) = True
        End If
cont:
    Next

    Dim i As Long
    For i = delRows.Count To 1 Step -1
        ws.Rows(delRows(i)).Delete
    Next

    SpeedOff
    MsgBox "部門ごとの複数列重複を削除しました: " & delRows.Count & "行"
End Sub
VB
  • 使いどころ: グループ内で重複排除したい場合の定番。

例題で練習

'例1：コード×日付の重複一覧
Sub Example_List2()
    ListDuplicates_TwoColumns
End Sub

'例2：部門×コード×枝番の重複ハイライト
Sub Example_Highlight3()
    HighlightDuplicates_ThreeColumns
End Sub

'例3：コード×日付の重複を安全削除（先頭を残す）
Sub Example_Remove2Safe()
    RemoveDuplicates_TwoColumns_Safe
End Sub

'例4：標準機能で複数列の重複削除
Sub Example_BuiltInMulti()
    RemoveDuplicates_BuiltIn_Multi
End Sub

'例5：部門ごとにコード×日付の重複削除
Sub Example_GroupMulti()
    RemoveDuplicates_ByGroup_MultiKey
End Sub
VB

実務の落とし穴と対策

  • 日付の文字列混在で誤判定
    • 対策: 比較前にNormDateTextでyyyy-mm-ddに統一。
  • 表記揺れ（空白・大小文字）で別物扱い
    • 対策: NormTextで正規化。必要なら全角→半角も検討。
  • 列順や見出し変更で壊れる
    • 対策: 見出し検索（Find）で列特定に拡張すると頑健。
  • いきなり削除が不安
    • 対策: まず一覧化・色ハイライト→承認→“下から削除”の2段階。
  • 大量データで遅い
    • 対策: Range→配列化＋Dictionary（今回のテンプレはセル直読でも十分だが、必要に応じて配列化へ）。

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