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

この記事でできること

月初に届く発注リスト3,000行。同じ顧客名が何度も出てくるのを、手作業でCtrl+Fしながら消していた。1時間かけて「たぶん全部消した」としか言えないのが地味にストレスだった。

この記事のVBAを使えば、指定した列の重複データを検出し、一意（ユニーク）のリストを別シートに出力できる。元データは一切変更しない。マクロを実行するだけで、重複なしのクリーンなリストが自動生成される。

• 対象：顧客リスト・発注リストなどで重複を探す作業がある人、VBAが初めての人
• 所要時間：コピペ → 実行まで約5分（目安）

複数のExcelファイルを1つに統合してからこの重複削除を実行すると効率的。統合の方法は 【VBA】複数Excelファイルを1つに統合する方法 を参照。

完成イメージ（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件のユニークリストになったとき、笑ってしまった。

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

業務で繰り返し使うなら、既存の「一意リスト」シートを上書きしたい、大文字・小文字を区別しないで欲しい、という要望がある。

重複を削除する前に、どのセルが重複しているか目視で確認したい場合は 【VBA】特定の文字を含むセルを検索してハイライトする方法 が参考になる。

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 で制御できる。

FAQ

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

複数列の値を結合してキーにする方法がある（key = cell1.Value & "_" & cell2.Value）。ただしコードが複雑になるため、ココナラで相談を推奨。

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

Dictionary の .Exists で重複を判定し、Interior.Color でハイライトする方法がある。セルの色付け方法は 【VBA】セルの値に応じて行を自動色分けする方法 を参照。検索でのハイライトは 【VBA】特定の文字を含むセルを検索してハイライトする方法 も参考になる。

Q3: Collection と Dictionary の違いは？

結論：重複処理には Dictionary が適している。本記事のコードは CreateObject を使っているため、参照設定は不要。

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

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

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

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

まとめ

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

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

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

関連記事

• 【VBA】複数Excelファイルを1つに統合する方法 — 複数ファイルを統合してから重複削除すると効率的
• 【VBA】フォルダ内のファイル一覧を自動取得する方法 — 複数ファイルからユニークリストを作る処理への発展に
• 【VBA】特定の文字を含むセルを検索してハイライトする方法 — 重複を削除する前にハイライトして確認したい場合

次にやりたくなること

• 【VBA】ExcelファイルをPDFに一括変換する方法 — ユニークリストをPDFにして上司に共有したい場合はこちら
• 【VBA】ExcelからOutlookメールを自動作成する方法 — ユニークリストをメールで配布したい場合はこちら

もっとカスタマイズしたい場合

「複数列の組み合わせで重複判定したい」「重複行ごとハイライトして確認したい」「重複削除＋統合を1つのマクロで自動化したい」など、業務に合わせたカスタマイズが必要な場合は、ココナラで相談できます。

相談時に以下の情報があるとスムーズです：

• Excel のバージョン / OS
• 重複判定の対象列（1列 or 複数列の組み合わせ）
• 大文字・小文字の扱い（区別するか、しないか）
• リストの行数（目安）

あわせて読みたい

• データの最終行・最終列を正確に取得する方法
• 空白行・空白セルを一括で削除する方法
• データを複数条件で自動並び替えする方法