Excel VBA 逆引き集 | 実務テンプレ完全版(超再利用部品) – 重複検査ツール

Excel VBA
スポンサーリンク

ねらい:人の目では見落とす「重複」を、VBAで一網打尽にする

重複検査は、地味だけど実務ではかなり重要な仕事です。
顧客マスタの二重登録、案件IDの重複、メールアドレスの重複、請求書番号の重複…。
どれも「あとから発覚するとめちゃくちゃ面倒」なやつですよね。

ここで作る「重複検査ツール」は、次のような“型”です。

指定した列(または複数列)をキーとして、
重複している行を洗い出し、
色を付けたり、別シートに一覧を出したりできるようにする。

この型をテンプレ化しておけば、
「今日は顧客マスタ」「明日は案件一覧」と、対象が変わっても、
ほぼ同じコードで重複チェックを回せるようになります。


基本設計:どの列を「重複キー」にするかを決める

単一キーと複合キーの考え方

重複検査の前に、必ず決めることがあります。
それは「何が同じだったら“重複”とみなすか」です。

顧客コードが同じなら重複。
メールアドレスが同じなら重複。
顧客名+電話番号が同じなら重複。

この「重複キー」を、1列だけにするのか、複数列の組み合わせにするのかで、ロジックが少し変わります。

ここではまず「1列だけをキーにする」版を作り、
そのあと「複数列を結合してキーにする」版に広げていきます。


共通基盤:範囲を配列で読み込み、Dictionaryで重複を検出する

単一列の重複検査の基本ロジック

重複検査の王道パターンはこうです。

対象列を上から順に見ていく。
Dictionary(ハッシュ表)に「値 → 最初に出てきた行番号」を記録する。
同じ値が2回目以降に出てきたら、「重複」として記録する。

これを VBA で書くと、次のようになります。

' ModDup_Base.bas
Option Explicit

Public Sub CheckDuplicate_OneColumn(ByVal ws As Worksheet, _
                                    ByVal keyCol As Long, _
                                    ByVal headerRow As Long)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
    If lastRow <= headerRow Then
        MsgBox "データ行がありません。", vbInformation
        Exit Sub
    End If
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1   ' vbTextCompare(大文字小文字を区別しない)
    
    Dim r As Long
    Dim key As String
    Dim firstRow As Long
    
    For r = headerRow + 1 To lastRow
        key = Trim$(CStr(ws.Cells(r, keyCol).Value))
        If key <> "" Then
            If dict.Exists(key) Then
                firstRow = dict(key)
                ws.Cells(r, keyCol).Interior.Color = RGB(255, 200, 200)
                ws.Cells(firstRow, keyCol).Interior.Color = RGB(255, 150, 150)
            Else
                dict.Add key, r
            End If
        End If
    Next
    
    MsgBox "重複検査が完了しました。(列 " & keyCol & ")", vbInformation
End Sub
VB

ここでの重要ポイントをしっかり押さえます。

Dictionary は「すでに見た値かどうか」を高速に判定するための道具です。
最初に出てきた行番号を記録しておき、2回目以降に出てきたときに「元の行」と「重複行」の両方に色を付けています。
空白は重複対象から除外しています(空白が多いと、全部重複扱いになってしまうため)。

この Sub は「どのシートにも使える汎用部品」です。
シートと列番号、ヘッダ行さえ渡せば、重複セルに色を付けてくれます。


例題:顧客マスタの「顧客コード」重複をチェックする

顧客マスタの前提

シート名を「CustomerMaster」とし、次のような構造を想定します。

A列:顧客コード
B列:顧客名
C列:住所
D列:電話番号

1行目がヘッダ、2行目以降がデータです。
顧客コード(A列)が重複していないかをチェックしたい。

実行用のラッパー Sub

Public Sub Run_CheckDup_CustomerCode()
    Dim ws As Worksheet
    Set ws = Worksheets("CustomerMaster")
    
    Call CheckDuplicate_OneColumn(ws, 1, 1)
End Sub
VB

この Sub をボタンに割り当てておけば、
ボタンを押すだけで「顧客コードが重複している行」が赤くハイライトされます。

最初に出てきた行は少し濃い赤、
2回目以降の行は少し薄い赤、
というように色を変えているので、「どれが元で、どれが重複か」が一目で分かります。


複合キー版:複数列を結合して「重複キー」を作る

顧客名+電話番号が同じなら重複、とみなす例

現場では、「顧客コードは違うけど、顧客名と電話番号が同じだから実質同じ顧客」というケースもあります。
このように「複数列の組み合わせ」で重複を見たいときは、
複数列の値を結合して1つのキー文字列にしてしまうのが簡単です。

例えば、顧客名(B列)と電話番号(D列)をキーにするなら、

キー = 顧客名 & “|” & 電話番号

のようにして、Dictionary に登録します。

複合キー重複検査のテンプレ

Public Sub CheckDuplicate_MultiColumn(ByVal ws As Worksheet, _
                                      ByVal keyCols As Variant, _
                                      ByVal headerRow As Long)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, keyCols(0)).End(xlUp).Row
    If lastRow <= headerRow Then
        MsgBox "データ行がありません。", vbInformation
        Exit Sub
    End If
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1
    
    Dim r As Long
    Dim key As String
    Dim i As Long
    Dim firstRow As Long
    
    For r = headerRow + 1 To lastRow
        key = ""
        For i = LBound(keyCols) To UBound(keyCols)
            key = key & "|" & Trim$(CStr(ws.Cells(r, keyCols(i)).Value))
        Next
        
        If key <> "" Then
            If dict.Exists(key) Then
                firstRow = dict(key)
                For i = LBound(keyCols) To UBound(keyCols)
                    ws.Cells(r, keyCols(i)).Interior.Color = RGB(255, 220, 200)
                    ws.Cells(firstRow, keyCols(i)).Interior.Color = RGB(255, 180, 160)
                Next
            Else
                dict.Add key, r
            End If
        End If
    Next
    
    MsgBox "複合キーでの重複検査が完了しました。", vbInformation
End Sub
VB

ここでのポイントは、「keyCols を Variant 配列で受け取る」ことです。
例えば、B列とD列をキーにしたいなら、Array(2, 4) を渡します。

キー文字列は「|」で区切って結合しています。
区切り文字は、実データに絶対に出てこないものを選ぶのが安全です(パイプ記号はまず出てきません)。

顧客名+電話番号で重複チェックする例

Public Sub Run_CheckDup_NameTel()
    Dim ws As Worksheet
    Set ws = Worksheets("CustomerMaster")
    
    Dim cols As Variant
    cols = Array(2, 4)   ' B列(顧客名)と D列(電話番号)
    
    Call CheckDuplicate_MultiColumn(ws, cols, 1)
End Sub
VB

これを実行すると、「顧客名と電話番号の組み合わせが同じ行」がハイライトされます。
顧客コードが違っていても、「実質同じ顧客」を見つけるのに役立ちます。


重複一覧を別シートに出すテンプレ:後から見返せる“報告書”にする

色を付けるだけでなく、「一覧表」として出力する

色を付けるだけでも十分便利ですが、
「重複一覧を別シートに出して、上長に報告したい」という場面もあります。

その場合は、「重複している行を別シートにコピーする」テンプレを用意します。

ここでは、単一列キー版を例にします。

Public Sub CheckDuplicate_OneColumn_ToSheet(ByVal ws As Worksheet, _
                                            ByVal keyCol As Long, _
                                            ByVal headerRow As Long, _
                                            ByVal outSheetName As String)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
    If lastRow <= headerRow Then
        MsgBox "データ行がありません。", vbInformation
        Exit Sub
    End If
    
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1
    
    Dim r As Long
    Dim key As String
    Dim firstRow As Long
    
    Dim wsOut As Worksheet
    On Error Resume Next
    Set wsOut = ThisWorkbook.Worksheets(outSheetName)
    On Error GoTo 0
    If wsOut Is Nothing Then
        Set wsOut = ThisWorkbook.Worksheets.Add
        wsOut.Name = outSheetName
    Else
        wsOut.Cells.Clear
    End If
    
    ws.Rows(headerRow).Copy wsOut.Rows(1)
    Dim outRow As Long
    outRow = 2
    
    For r = headerRow + 1 To lastRow
        key = Trim$(CStr(ws.Cells(r, keyCol).Value))
        If key <> "" Then
            If dict.Exists(key) Then
                firstRow = dict(key)
                
                ws.Rows(firstRow).Copy wsOut.Rows(outRow)
                outRow = outRow + 1
                
                ws.Rows(r).Copy wsOut.Rows(outRow)
                outRow = outRow + 1
            Else
                dict.Add key, r
            End If
        End If
    Next
    
    wsOut.Columns.AutoFit
    MsgBox "重複行をシート「" & outSheetName & "」に出力しました。", vbInformation
End Sub
VB

このテンプレでは、重複が見つかるたびに「元の行」と「重複行」の2行を、
まとめて outSheet にコピーしています。

同じキーで3件以上ある場合は、元行が何度も出てきますが、
「どの行が同じグループか」が視覚的に分かりやすくなります。


例題:メールアドレス重複を別シートに一覧出力する

シート「Users」に、次のような表があるとします。

A列:ユーザーID
B列:氏名
C列:メールアドレス

メールアドレスの重複をチェックし、
重複行を「Dup_Mail」シートに一覧出力したい。

その場合のラッパー Sub はこうなります。

Public Sub Run_CheckDup_Mail_ToSheet()
    Dim ws As Worksheet
    Set ws = Worksheets("Users")
    
    Call CheckDuplicate_OneColumn_ToSheet(ws, 3, 1, "Dup_Mail")
End Sub
VB

実行すると、「Dup_Mail」シートに重複行がまとまって出てきます。
あとはそこを見ながら、「どれを残して、どれを削除するか」を判断できます。


重要ポイントの深掘り:重複検査でハマりやすいところ

「空白」をどう扱うかを決めておく

空白セルを重複とみなすかどうかは、必ず先に決めておくべきポイントです。

多くのケースでは、「空白は重複対象外」にした方が現実的です。
空白が多い列で重複検査をすると、空白ばかり引っかかってしまい、本当に見たい重複が埋もれてしまうからです。

今回のテンプレでは、key <> "" という条件で空白を除外しています。
もし「空白も重複として検出したい」なら、この条件を外せばOKです。

大文字・小文字、全角・半角の扱い

メールアドレスやコードなどで、「大文字・小文字」「全角・半角」をどう扱うかも重要です。

Dictionary の CompareMode = 1(vbTextCompare)を指定すると、
大文字・小文字は区別されません(”ABC” と “abc” は同じとみなされる)。

全角・半角は別物として扱われます。
もし「全角英数字を半角に揃えてから比較したい」などの要件があれば、
キーを作る前に StrConv や自作の正規化関数を通す必要があります。

まずは「大文字・小文字は区別しない」「全角・半角は区別する」くらいから始めて、
必要になったら正規化を足していくのが現実的です。

「見た目は同じだけど、実は違う」ケース

例えば、電話番号で

“03-1234-5678”
“0312345678”

のように、ハイフンの有無だけが違う場合、
そのまま比較すると「別物」として扱われます。

こういう列は、重複検査の前に「正規化」しておくのが鉄則です。

電話番号なら、数字だけを抜き出して比較用の列を作る。
メールアドレスなら、前後の空白を削除し、小文字に揃える。

重複検査ツールそのものは「比較するだけ」なので、
「何をどう揃えてから比較するか」は、前処理として別テンプレに切り出しておくときれいに分離できます。

行数が多いときのパフォーマンス

Dictionary を使っているので、数千~数万行程度なら十分実用的な速度で動きます。
ただし、10万行を超えるような巨大データでは、
画面の再描画や色塗りがボトルネックになることがあります。

その場合は、

Application.ScreenUpdating = False で画面更新を止める
色塗りを最小限にする(重複行だけにする、など)
重複一覧を別シートに出す方式にして、元シートには色を付けない

といった工夫で、体感速度をかなり改善できます。


まとめ:重複検査も「キーの作り方」と「結果の見せ方」をテンプレ化する

重複検査ツールの本質は、次の2つです。

どの列(または列の組み合わせ)をキーにして比較するか。
重複を見つけたときに、どう見せるか(色を付ける/別シートに出す)。

Dictionary を使った基本ロジックさえ押さえておけば、

単一列の重複検査
複合キーの重複検査
重複行のハイライト
重複一覧の別シート出力

を、ほぼコピペで組み合わせて使えるようになります。

タイトルとURLをコピーしました