Excel VBA 逆引き集 | 重複候補リスト作成

Excel VBA
スポンサーリンク

重複候補リスト作成

「いきなり削除は怖い。まず“消す候補”だけ一覧にして確認したい」——重複候補を安全に洗い出すテンプレです。ポイントは、キーの正規化、配列＋Dictionaryで高速突合、下から削除できる行番号を揃えること。

方針と安全設計

  • 対象のキー: どの列で重複を判定するか（例：A列のコード、A×Bの複合キー）。
  • 候補の定義: “2回目以降”の出現を削除候補とする（先頭は残す）。
  • 安全運用: 元表は触らず候補シートへ行番号を出力→承認後に下から削除。

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

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 NormKey(ByVal v As Variant) As String
    ' 前後空白除去＋大文字化（必要なら全角→半角も追加）
    NormKey = UCase$(Trim$(CStr(v)))
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
  • ポイント: 画面更新・イベント・計算を止めて高速化。出力先シートは安全に生成。

単一キー版：A列の重複候補（2回目以降）を一覧化

A列の値をキーとして、2回目以降の行番号を「重複候補」へ出力します。

Sub MakeDuplicateCandidates_SingleKey()
    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 = NormKey(ws.Cells(r, "A").Value)
        If Len(k) = 0 Then GoTo cont
        If seen.Exists(k) Then
            delRows.Add r          ' 2回目以降は候補
        Else
            seen(k) = True         ' 初回は残す前提
        End If
cont:
    Next

    Dim out As Worksheet: Set out = EnsureSheet("重複候補", True)
    out.Range("A1:C1").Value = Array("行番号", "キー", "備考")
    Dim i As Long: i = 2
    Dim x As Long
    For x = 1 To delRows.Count
        r = delRows(x)
        out.Cells(i, 1).Value = r
        out.Cells(i, 2).Value = NormKey(ws.Cells(r, "A").Value)
        out.Cells(i, 3).Value = "2回目以降"
        i = i + 1
    Next

    out.Columns.AutoFit
    SpeedOff
    MsgBox "重複候補を作成しました（" & delRows.Count & "行）"
End Sub
VB
  • ポイント: 初回は残す、2回目以降を候補化。空値は除外。

複合キー版：A×Bで重複候補を作成（コード×日付など）

A列（コード）とB列（日付）の組み合わせをキーにして候補を出します。日付はyyyy-mm-ddで統一。

Private Function BuildCompositeKey(ByVal v1 As Variant, ByVal v2 As Variant) As String
    Dim d As String
    If IsDate(v2) Then
        d = Format$(CDate(v2), "yyyy-mm-dd")
    Else
        d = UCase$(Trim$(CStr(v2)))
    End If
    BuildCompositeKey = NormKey(v1) & "|" & d
End Function

Sub MakeDuplicateCandidates_CompositeKey()
    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, key As String
    For r = 2 To lastRow
        key = BuildCompositeKey(ws.Cells(r, "A").Value, ws.Cells(r, "B").Value)
        If Len(key) = 0 Then GoTo cont
        If seen.Exists(key) Then
            delRows.Add r
        Else
            seen(key) = True
        End If
cont:
    Next

    Dim out As Worksheet: Set out = EnsureSheet("重複候補(複合)", True)
    out.Range("A1:D1").Value = Array("行番号", "コード", "日付", "備考")
    Dim i As Long: i = 2
    Dim x As Long
    For x = 1 To delRows.Count
        r = delRows(x)
        out.Cells(i, 1).Value = r
        out.Cells(i, 2).Value = NormKey(ws.Cells(r, "A").Value)
        out.Cells(i, 3).Value = Format$(CDate(ws.Cells(r, "B").Value), "yyyy/mm/dd")
        out.Cells(i, 4).Value = "2回目以降"
        i = i + 1
    Next

    out.Columns.AutoFit
    SpeedOff
    MsgBox "複合キーの重複候補を作成しました（" & delRows.Count & "行）"
End Sub
VB
  • ポイント: 区切りは安全な文字「|」。日付の表記揺れを吸収。

候補の可視化：元データを色でマーク（削除せず確認）

「重複候補」の行番号を使い、元表の対象行を淡赤で塗ります。

Sub HighlightCandidates_FromList()
    SpeedOn

    Dim wsData As Worksheet: Set wsData = Worksheets("Data")
    Dim wsList As Worksheet: Set wsList = Worksheets("重複候補")
    Dim lastRow As Long: lastRow = wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Row

    ' 全体クリア（必要なら範囲を絞る）
    wsData.Cells.Interior.ColorIndex = xlNone

    Dim r As Long
    For r = 2 To lastRow
        Dim rowNum As Long: rowNum = CLng(wsList.Cells(r, 1).Value)
        If rowNum >= 2 Then wsData.Rows(rowNum).Interior.Color = RGB(255, 230, 230)
    Next

    SpeedOff
    MsgBox "重複候補行を淡赤でハイライトしました"
End Sub
VB
  • ポイント: まず見える化→承認→削除の順で安全に進める。

その先の一手：承認後に下から削除（候補シートを参照）

候補行を削除する際は、必ず行番号の大きい方から処理します。

Sub ApplyDeletion_FromCandidates()
    SpeedOn

    Dim wsData As Worksheet: Set wsData = Worksheets("Data")
    Dim wsList As Worksheet: Set wsList = Worksheets("重複候補")
    Dim lastRow As Long: lastRow = wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Row

    ' 行番号を配列へ（下から削除）
    Dim i As Long, n As Long: n = lastRow - 1
    If n <= 0 Then SpeedOff: MsgBox "候補がありません": Exit Sub

    Dim rowsArr() As Long: ReDim rowsArr(1 To n)
    For i = 2 To lastRow
        rowsArr(i - 1) = CLng(wsList.Cells(i, 1).Value)
    Next

    ' ソート：降順（簡易バブルでもOK、件数少なら不要）
    Dim a As Long, b As Long, tmp As Long
    For a = 1 To n - 1
        For b = a + 1 To n
            If rowsArr(a) < rowsArr(b) Then
                tmp = rowsArr(a): rowsArr(a) = rowsArr(b): rowsArr(b) = tmp
            End If
        Next
    Next

    ' 削除実行（下から）
    For i = 1 To n
        If rowsArr(i) >= 2 Then wsData.Rows(rowsArr(i)).Delete
    Next

    SpeedOff
    MsgBox "重複候補の削除を適用しました（" & n & "行）"
End Sub
VB
  • ポイント: 上から削除は行が詰まってズレます。必ず“下から”。

実務の落とし穴と対策

  • キー表記揺れで判定ブレ
    • 対策: NormKeyでTrim＋大文字化。必要なら半角化や記号除去も追加。
  • 日付の形式混在
    • 対策: CDate＋Formatで統一。文字列日付は変換を試みる。
  • 見出しや列順の変更
    • 対策: 固定列番号を避け、Findで見出しから列特定に拡張。
  • いきなり削除の事故
    • 対策: 候補→色で確認→承認→削除の2段階運用。バックアップも習慣化。

例題で練習

'例1：A列の重複候補（2回目以降）を一覧化
Sub Example_MakeCandidates_Single()
    MakeDuplicateCandidates_SingleKey
End Sub

'例2：コード×日付（A×B）の複合キーで候補作成
Sub Example_MakeCandidates_Composite()
    MakeDuplicateCandidates_CompositeKey
End Sub

'例3：候補行を淡赤でハイライト
Sub Example_HighlightCandidates()
    HighlightCandidates_FromList
End Sub

'例4：承認後に候補行を“下から”削除
Sub Example_ApplyDeletion()
    ApplyDeletion_FromCandidates
End Sub
VB

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