【VBA】重複データを一括削除して一意のリストを作る方法（コピペOK）

どんな場面で使う？

• 顧客リストの名寄せで、同じ会社名が何行も重複している
• 複数部署から集めたデータを統合した後に重複を除きたい
• ドロップダウンリストの選択肢として、既存データから一意のリストを作りたい
• 発注リストの集計前に、重複する品番や商品名を整理したい

—

完成イメージ（Before / After）

Before（実行前）

A列「顧客名」に重複がある状態。

After（実行後）

新しいシート「一意リスト」に重複なしの顧客名が出力される。元データはそのまま残る。

結果：元データ6行 → 一意リスト4件（重複2件を除外）

—

実行前の準備

バックアップを取る

このマクロは元データを変更しないが、念のためバックアップを取ること。別シートを追加する処理があるため、ファイルの構成は変わる。

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

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

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

対象列を確認する

重複を判定したい列の番号を確認しておく。A列=1、B列=2、C列=3…。

—

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

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

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

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

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

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

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

1. 下の「コード（最小版）」をコピーして、コードウィンドウに貼り付ける
2. コード内の targetCol を自分の対象列番号に書き換える
3. 対象のシートを表示した状態で Alt + F8 を押す
4. 「ExtractUnique」を選択して「実行」
5. 新しいシート「一意リスト」に結果が出力される

—

コード（最小版）– 指定列の一意リストを別シートに出力

まずはこれだけで動く。アクティブシートの指定列から重複を除いた一意の値を、新しいシートに出力する。

Sub ExtractUnique()

    Dim ws As Worksheet
    Dim wsOut As Worksheet
    Dim dict As Object
    Dim targetCol As Long
    Dim lastRow As Long
    Dim i As Long
    Dim cellValue As String
    Dim keys As Variant
    Dim outRow As Long

    ' --- ★ ここを対象の列番号に書き換える（A列=1, B列=2, ...） ---
    targetCol = 1

    Set ws = ActiveSheet

    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, targetCol).End(xlUp).Row

    ' Dictionary を作成（重複判定の核）
    Set dict = CreateObject("Scripting.Dictionary")

    ' 画面更新を停止（高速化）
    Application.ScreenUpdating = False

    ' 2行目から開始（1行目はヘッダーと想定）
    For i = 2 To lastRow

        cellValue = CStr(ws.Cells(i, targetCol).Value)

        ' 空白セルはスキップ
        If cellValue <> "" Then
            ' まだ登録されていなければ追加
            If Not dict.Exists(cellValue) Then
                dict.Add cellValue, i  ' 値=キー、初出の行番号=値
            End If
        End If

    Next i

    ' 出力用シートを追加
    Set wsOut = ThisWorkbook.Worksheets.Add(After:=ws)
    wsOut.Name = "一意リスト"

    ' ヘッダーをコピー
    wsOut.Cells(1, 1).Value = ws.Cells(1, targetCol).Value

    ' 一意の値を出力
    keys = dict.keys
    For i = 0 To dict.Count - 1
        wsOut.Cells(i + 2, 1).Value = keys(i)
    Next i

    ' 画面更新を再開
    Application.ScreenUpdating = True

    MsgBox "完了" & vbCrLf & _
           "元データ：" & (lastRow - 1) & " 行" & vbCrLf & _
           "一意リスト：" & dict.Count & " 件" & vbCrLf & _
           "重複：" & (lastRow - 1 - dict.Count) & " 件", vbInformation

    Set dict = Nothing

End Sub

コードの動作：

1. 指定列の2行目から最終行までをループ（1行目はヘッダー）
2. 各セルの値を Dictionary のキーとして登録（既に存在する場合はスキップ）
3. 新しいシート「一意リスト」を作成
4. Dictionary のキー一覧を出力
5. 元データの行数、一意の件数、重複の件数を表示

対象列について： targetCol = 1 の部分を自分の対象列番号に書き換える。A列=1、B列=2、C列=3…。

※ 2回目以降に実行する場合は、既存の「一意リスト」シートを手動で削除してから実行すること。自動で上書きしたい場合は下の実務版を使う。

自分はこの最小版で十分だった。3,000行の発注リストが一瞬で420件のユニークリストになったとき、笑ってしまった。重複確認で1時間かかっていた作業が数秒で終わる体験は衝撃だった。

—

コード（実務版）– 重複件数表示＋既存シートチェック＋大文字小文字統一

業務で繰り返し使うなら、既存の「一意リスト」シートを上書きしたい、大文字・小文字を区別しないで欲しい、という要望がある。この実務版を導入してからは、毎月の重複クリーニングが完全にルーティン化できた。大文字小文字の表記ゆれで別データ扱いになっていた問題も一気に解消された。

重複を削除する前に、どのセルが重複しているか目視で確認したい場合はvba-find-highlightが参考になる。

Sub ExtractUniqueEx()

    Dim ws As Worksheet
    Dim wsOut As Worksheet
    Dim dict As Object
    Dim targetCol As Long
    Dim lastRow As Long
    Dim i As Long
    Dim cellValue As String
    Dim keys As Variant
    Dim outRow As Long
    Dim sheetName As String

    ' --- ★ ここを対象の列番号に書き換える（A列=1, B列=2, ...） ---
    targetCol = 1
    sheetName = "一意リスト"

    Set ws = ActiveSheet

    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, targetCol).End(xlUp).Row

    If lastRow < 2 Then
        MsgBox "データが見つかりませんでした。", vbExclamation
        Exit Sub
    End If

    ' Dictionary を作成
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare  ' 大文字・小文字を区別しない

    ' 画面更新を停止（高速化）
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' --- 既存の出力シートがあれば削除 ---
    For Each wsOut In ThisWorkbook.Worksheets
        If wsOut.Name = sheetName Then
            wsOut.Delete
            Exit For
        End If
    Next wsOut

    ' 2行目から開始（1行目はヘッダーと想定）
    For i = 2 To lastRow

        cellValue = Trim(CStr(ws.Cells(i, targetCol).Value))

        ' 空白セルはスキップ
        If cellValue <> "" Then
            ' まだ登録されていなければ追加
            If Not dict.Exists(cellValue) Then
                dict.Add cellValue, i
            End If
        End If

    Next i

    ' 出力用シートを追加
    Set wsOut = ThisWorkbook.Worksheets.Add(After:=ws)
    wsOut.Name = sheetName

    ' ヘッダーをコピー
    wsOut.Cells(1, 1).Value = ws.Cells(1, targetCol).Value

    ' 一意の値を出力
    If dict.Count > 0 Then
        keys = dict.keys
        For i = 0 To dict.Count - 1
            wsOut.Cells(i + 2, 1).Value = keys(i)
        Next i
    End If

    ' 列幅を自動調整
    wsOut.Columns(1).AutoFit

    ' 画面更新を再開
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "完了" & vbCrLf & _
           "元データ：" & (lastRow - 1) & " 行" & vbCrLf & _
           "一意リスト：" & dict.Count & " 件" & vbCrLf & _
           "重複：" & (lastRow - 1 - dict.Count) & " 件" & vbCrLf & _
           "シート「" & sheetName & "」に出力しました。", vbInformation

    Set dict = Nothing

End Sub

追加ポイント：

• dict.CompareMode = vbTextCompare で大文字・小文字を区別しない（「TOKYO」と「Tokyo」を同一扱い）
• Trim() で前後の空白を除去（半角スペースが混入していても同一扱い）
• 既存の「一意リスト」シートがあれば削除して再作成（何度でも実行可能）
• DisplayAlerts = False でシート削除時の確認ダイアログを非表示
• 列幅を自動調整（AutoFit）
• データが空の場合に早期終了

※ CompareMode はキーを追加する前に設定すること。キーを追加した後に変更すると実行時エラーになる。

注意： CompareMode = vbTextCompare にすると「TOKYO」「Tokyo」「tokyo」はすべて同一扱いになる。大文字・小文字を区別したい場合は、この行を削除するか vbBinaryCompare に変更すること。

—

よくある落とし穴5選

自分がCollectionオブジェクトで重複削除を試みたとき、On Error Resume Nextで重複エラーを握りつぶしていた。一見動いたが、後日「TOKYO」と「Tokyo」が両方残っていることに上司が気づいて冷や汗をかいた。Collectionは大文字・小文字を区別しない比較モードの設定ができない。Dictionaryなら CompareMode で制御できる。

自分も最初、CStr() で文字列変換せずにDictionaryに追加していた。すると数値の 100 と文字列の "100" が別のキーとして登録されてしまい、「重複が消えてない」と上司に指摘されてしまった。それ以来、キーに追加する前に必ず CStr() で統一するようにしている。

VBAで重複削除したのに重複が残るときの対処法

「マクロを実行したのにまだ重複が残っている」という場合、原因は大文字・小文字や全角・半角の表記ゆれでDictionaryが別のキーとして認識していることだ。実務版コードの dict.CompareMode = vbTextCompare で大文字小文字を統一し、Trim() で前後の空白も除去すれば解決する。

VBAの重複削除でエラー457が出るときの対処法

「実行時エラー ‘457’が出て処理が止まる」という場合、原因はCollectionオブジェクトに重複キーを追加しようとしていることだ。Collectionでは重複チェックができないため、Dictionaryに切り替えて .Exists で事前チェックしてから .Add する方式にすれば解決する。

—

FAQ

Q1: 複数列の組み合わせで重複判定したい（氏名＋電話番号）

Q2: 重複行をハイライトして確認したい（削除せずに）

Dictionary の .Exists で重複を判定し、Interior.Color でハイライトする方法がある。セルの色付け方法はvba-color-rows-by-valueを参照。検索でのハイライトはvba-find-highlightも参考になる。

Q3: Collection と Dictionary の違いは？

結論：重複処理には Dictionary が適している。本記事のコードは CreateObject を使っているため、参照設定は不要。Dictionaryをさらに活用したい場合はvba-dictionary-uniqueを参照。

Q4: 元データから重複行を直接削除したい

下から上にループして .EntireRow.Delete で削除する方法がある。ただし元データを破壊するため、必ずバックアップを取ること。安全性を優先するなら、本記事の「別シートに出力」方式を推奨。

Q5: 重複の件数だけ知りたい（リストは不要）

最小版コードの「出力用シートを追加」以降の処理を削除し、MsgBox だけ残せば、件数のみ表示できる。

—

まとめ

この記事で、指定列の重複データを検出し、一意のリストを別シートに出力できるようになった。

• 最小版：指定列から一意の値を別シートに出力（元データは変更なし）
• 実務版：大文字小文字の統一＋空白除去＋既存シート上書き＋件数表示

重要なのは、元データを直接削除しないこと。別シートに出力する方式なら、間違いがあっても元データに戻れる。

関連記事

• vba-merge-excel-files — 複数Excelファイルを1つに統合する方法。複数ファイルを統合してから重複削除すると効率的
• vba-find-highlight — 特定の文字を含むセルを検索してハイライトする方法。重複を削除する前にハイライトして確認したい場合
• vba-color-rows-by-value — セルの値に応じて行を自動色分けする方法。重複行をハイライト表示して目視確認したい場合に
• vba-dropdown-validation — 入力規則（ドロップダウンリスト）をVBAで一括設定する方法。重複を除いたユニークリストをドロップダウンの選択肢に使える
• vba-dictionary-unique — Dictionaryで重複チェック・集計を高速化する方法。Dictionaryをさらに活用して大量データの高速検索・集計に応用したい場合に

次にやりたくなること

• vba-dictionary-unique — Dictionaryで高速集計。本記事で学んだDictionaryオブジェクトを、集計・検索にも応用できる。重複削除の次のステップとして最適
• vba-dropdown-validation — ドロップダウンリスト設定。重複を除いたユニークリストをそのままドロップダウンの選択肢に使える。入力規則の一括設定で、データ入力の品質も上がる
• vba-merge-excel-files — 複数Excelファイルを1つに統合。統合後に重複削除を実行する流れで、データクリーニングが一気通貫になる
• vba-find-highlight — 特定の文字を含むセルを検索してハイライト。重複を削除する前に、重複しているセルをハイライトして目視確認したい場合に
• vba-find-replace-text — セルの文字列を一括置換。重複の原因になる表記ゆれを事前に統一してから重複削除すると精度が上がる

—