VBAで重複行を削除するには、Range.RemoveDuplicates メソッドを使います。手作業の「重複の削除」と同じ処理を、対象の範囲・重複を判定する列・見出しの有無を指定して実行できます。

ただし、マクロで削除した結果は「元に戻す」(Ctrl+Z)では戻せません。この記事では、基本の書き方に加えて、次の2つまでを説明します。

  • 実行前に元のデータを退避する
  • 削除前後の件数をログに残して確認する

RemoveDuplicatesの基本の書き方

Range("A1:D100").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes
引数 指定する内容
Columns 重複を判定する列の番号。シートの列番号ではなく、対象範囲の左端を1とした番号
Header 先頭行が見出しかどうか。xlYes(見出しあり)、xlNo(見出しなし)、xlGuess(Excelが判断)

この例では、A1:D100のうち、A列(1列目)とC列(3列目)の値が両方とも一致する行を重複とみなします。上にある行を1つ残し、それより下の重複行を削除します。

押さえておきたい点は次の4つです。

  • 列番号は範囲の中での位置:範囲がB1:E100なら、Array(1) はB列を指します。範囲の開始列を変えたら、列番号も見直してください
  • Headerは必ず指定する:省略すると、見出しなし(xlNo)として扱われます。見出しのある表ではxlYesを指定します。xlGuessはExcelが判断を誤ることがあるため、業務で使うマクロでは使わないほうが確実です
  • 範囲の外のセルは動かない:削除・上詰めされるのは、指定した範囲の中のセルだけです。表の一部の列だけを範囲にすると、範囲の外の列は上に詰められず、行の対応がずれます。範囲には必ず表全体を指定します
  • 削除件数は返ってこない:RemoveDuplicatesは、何件削除したかを返しません。件数を記録したいときは、実行前後の行数を自分で数えます

どの行を残すかの考え方は、手作業の「重複の削除」と同じです。上の行が残るので、残したい行が上に来るよう、事前に並べ替えておきます。

判定する列を変数で渡すときの注意

判定する列を変数の配列で渡すと、「実行時エラー '5': プロシージャの呼び出し、または引数が不正です。」が出ることがあります。その場合は、変数を丸かっこで囲んで渡してください。

Dim keyCols As Variant
keyCols = Array(1, 3)

rng.RemoveDuplicates Columns:=(keyCols), Header:=xlYes

全列が一致する行だけを削除したい場合は、表の列数に合わせて配列を作ります。

Dim allCols() As Variant
Dim i As Long

ReDim allCols(0 To rng.Columns.Count - 1)
For i = 0 To rng.Columns.Count - 1
    allCols(i) = i + 1
Next i

rng.RemoveDuplicates Columns:=(allCols), Header:=xlYes

退避・確認・ログまで含めたマクロ

実務で使うときは、次の流れで実行します。

  1. フィルターを解除する
  2. 対象範囲と削除前の件数を表示し、実行してよいか確認する
  3. 元のシートを丸ごとコピーして退避する
  4. RemoveDuplicatesで重複行を削除する
  5. 削除後の件数を数える
  6. 実行日時・範囲・判定列・削除前後の件数・退避先を、「削除ログ」シートに書き込む

次のマクロは、マクロを保存したブックの「顧客一覧」シートが対象です。A1から始まる見出し付きの表で、1列目と3列目を使って重複を判定します。シート名・開始セル・判定列は、実際の表に合わせて書き換えてください。

Option Explicit

Sub RemoveDuplicatesWithLog()
    Const SHEET_NAME As String = "顧客一覧"
    Const START_CELL As String = "A1"

    Dim ws As Worksheet
    Dim backupWs As Worksheet
    Dim rng As Range
    Dim keyCols As Variant
    Dim colsText As String
    Dim beforeCount As Long
    Dim afterCount As Long

    Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
    keyCols = Array(1, 3)   ' 範囲の1列目と3列目が両方一致したら重複
    colsText = "列" & Join(keyCols, ",列")

    ' 1. フィルターを解除
    If ws.FilterMode Then ws.ShowAllData

    ' 2. 範囲と件数を確認
    Set rng = ws.Range(START_CELL).CurrentRegion
    beforeCount = rng.Rows.Count - 1   ' 見出し行を除く

    If MsgBox("対象範囲:" & rng.Address(False, False) & vbCrLf & _
              "判定列:" & colsText & vbCrLf & _
              "削除前の件数:" & beforeCount & vbCrLf & vbCrLf & _
              "元のシートを退避してから重複行を削除します。", _
              vbOKCancel + vbQuestion, "重複行の削除") <> vbOK Then
        Exit Sub
    End If

    ' 3. シートごと退避
    ws.Copy After:=ws
    Set backupWs = ws.Next
    backupWs.Name = "退避_" & Format(Now, "yyyymmdd_hhnnss")

    ' 4. 重複行を削除
    rng.RemoveDuplicates Columns:=(keyCols), Header:=xlYes

    ' 5. 削除後の件数
    afterCount = ws.Range(START_CELL).CurrentRegion.Rows.Count - 1

    ' 6. ログに記録
    WriteLog ws.Name, rng.Address(False, False), colsText, _
             beforeCount, afterCount, backupWs.Name

    ws.Activate
    MsgBox "削除前:" & beforeCount & " 件" & vbCrLf & _
           "削除後:" & afterCount & " 件" & vbCrLf & _
           "削除した行:" & (beforeCount - afterCount) & " 件", _
           vbInformation, "重複行の削除"
End Sub

Private Sub WriteLog(ByVal sheetName As String, ByVal addr As String, _
                     ByVal colsText As String, ByVal beforeCount As Long, _
                     ByVal afterCount As Long, ByVal backupName As String)
    Dim logWs As Worksheet
    Dim r As Long

    On Error Resume Next
    Set logWs = ThisWorkbook.Worksheets("削除ログ")
    On Error GoTo 0

    If logWs Is Nothing Then
        Set logWs = ThisWorkbook.Worksheets.Add( _
            After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        logWs.Name = "削除ログ"
        logWs.Range("A1:H1").Value = Array("実行日時", "シート", "範囲", "判定列", _
                                           "削除前", "削除後", "削除件数", "退避先")
    End If

    r = logWs.Cells(logWs.Rows.Count, 1).End(xlUp).Row + 1
    logWs.Cells(r, 1).Resize(1, 8).Value = Array(Now, sheetName, addr, colsText, _
                                                 beforeCount, afterCount, _
                                                 beforeCount - afterCount, backupName)
End Sub

このマクロについての補足です。

  • CurrentRegionの範囲:CurrentRegion は、A1から、空白の行・列で区切られるところまでの範囲です。表の途中に完全に空白の行や列があると、そこで範囲が切れます。初めて実行するときは、確認メッセージに表示される範囲が表全体になっているかを必ず確かめてください
  • 件数の数え方:件数は「範囲の行数−見出しの1行」で数えています
  • 判定列の書き方:ログには「列1,列3」の形で記録しています。「1,3」のような数字だけの文字列をセルに書き込むと、Excelが数値として読み取ってしまうことがあるためです
  • フィルターの解除:非表示の行が残ったままだと、削除結果を画面で確かめにくくなるため、最初に解除しています
  • 退避シートの扱い:退避シートは、結果を確かめ終わるまで残しておきます。不要になったら手作業で削除してください

テーブル(ListObject)に対して実行する場合

表をExcelのテーブルにしている場合は、テーブルの範囲と列名を使います。列の並びが変わっても、行が増減しても、マクロを直さずに済みます。

Dim tbl As ListObject
Dim keyCols As Variant
Dim beforeCount As Long, afterCount As Long

Set tbl = ThisWorkbook.Worksheets("顧客一覧").ListObjects("T_顧客")

' 列名から、テーブル内での列番号を取得する
keyCols = Array(tbl.ListColumns("顧客ID").Index, tbl.ListColumns("請求月").Index)

beforeCount = tbl.ListRows.Count
tbl.Range.RemoveDuplicates Columns:=(keyCols), Header:=xlYes
afterCount = tbl.ListRows.Count

Debug.Print "削除前:" & beforeCount & " 削除後:" & afterCount

ListColumns("列名").Index は、テーブルの左端を1とした列番号です。そのため、tbl.Range に対する列番号としてそのまま使えます。

テーブルに対して実行する場合も、退避とログは前のマクロと同じように組み込んでください。

実行後に確認すること

  • 削除件数が想定どおりか:ログの削除件数が0なら、見た目は同じでも、空白や全角・半角の違いで値が異なっている可能性があります。想定より多いなら、判定列が少なすぎないかを見直します
  • 消えた行が本当に重複だったか:退避シートから判定列の値が同じ行を数件選び、削除後のシートに1行だけ残っているかを確かめます
  • 列がずれていないか:表の右端の列まで、各行の値が正しく並んでいるかを数行確認します
  • ほかのシートの数式:この表を参照している数式がほかのシートにある場合は、参照先がずれていないか、エラーになっていないかを確認します

よく出るエラー

エラー 主な原因
実行時エラー '5' 判定列を変数で渡している(丸かっこで囲む)。列番号が範囲の列数を超えている。配列が空になっている
実行時エラー '1004' シートが保護されている。範囲の指定が誤っている。結合セルが含まれている など
実行時エラー '9' シート名やテーブル名が、実際の名前と一致していない

エラーが出たら、まずはイミディエイトウィンドウで範囲や配列の中身を確認してください。Debug.Print rng.Address や Debug.Print Join(keyCols, ",") で確認できます。

おすすめの記事