空白行と重複行を削除する（下から削除する理由と RemoveDuplicates の使い方）

どんな場面で使うか

複数の担当者から集めた一覧を1枚に貼り合わせると、途中に空白行が残ったり、同じデータが二重に入ったりします。空白行があると最終行の取得やオートフィルターの範囲が途中で切れ、重複があると件数や合計が実際より多くなってしまいます。

集計の前に空白行と重複行を取り除く処理をマクロにしておくと、毎回同じ基準でデータを整えられます。どちらも行を削除する処理なので、元に戻せるようバックアップを取ってから実行することをおすすめします。

空白行の削除は下から行う

行を削除すると、その下の行が1行ずつ上に詰まります。上から順にループしながら削除すると、削除した行の位置に次の行が移動してきますが、ループのカウンタは次の行へ進んでしまうため、連続した空白行の2行目が飛ばされて残ります。

下の行から上に向かってループすれば、削除しても、まだ判定していない上側の行の位置は変わりません。For 文で Step -1 を指定するのはそのためです。さらに、削除する行を Union でまとめておき、最後に一度で削除すると、1行ずつ削除するより速く動きます。

Sub DeleteBlankRows()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long, r As Long
    Dim delRng As Range

    Set ws = ThisWorkbook.Worksheets("一覧")
    ' 最終行は使用範囲から求める（空白行が途中にあっても最後まで見る）
    lastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    For r = lastRow To 2 Step -1                     ' 下から上へ（1行目は見出し）
        If WorksheetFunction.CountA(ws.Cells(r, 1).Resize(1, lastCol)) = 0 Then
            If delRng Is Nothing Then
                Set delRng = ws.Rows(r)
            Else
                Set delRng = Union(delRng, ws.Rows(r))
            End If
        End If
    Next r

    If delRng Is Nothing Then
        MsgBox "空白行はありませんでした"
    Else
        delRng.Delete                                ' まとめて一度で削除
        MsgBox "空白行を削除しました"
    End If
End Sub

RemoveDuplicates で重複行を削除する

重複の削除には、Excel の「重複の削除」機能と同じ RemoveDuplicates メソッドが使えます。Columns で重複を判定する列を指定し、Header で見出しの有無を指定します。次の例は、A列（日付）・B列（伝票番号）・D列（商品コード）の3つがすべて同じ行を重複とみなして削除します。

Sub DeleteDuplicateRows()
    Dim ws As Worksheet, tbl As Range
    Dim lastRow As Long, lastCol As Long, beforeCnt As Long, afterCnt As Long

    Set ws = ThisWorkbook.Worksheets("一覧")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    If lastRow < 3 Then Exit Sub

    Set tbl = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
    beforeCnt = lastRow - 1
    tbl.RemoveDuplicates Columns:=Array(1, 2, 4), Header:=xlYes

    afterCnt = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1
    MsgBox beforeCnt - afterCnt & " 件の重複を削除しました（残り " & afterCnt & " 件）"
End Sub

どの行が残るかに注意する

RemoveDuplicates は、重複したデータのうち上にある行を残し、下にある行を削除します。たとえば同じ伝票の「修正前」と「修正後」が両方あり、新しい方を残したい場合は、先に更新日時の新しい順に並べ替えてから実行する必要があります。

また、判定は見た目ではなくセルの値で行われるため、末尾に空白が付いた「A001 」と「A001」、全角と半角が違うコードは別のデータとして残ります。重複を確実に取り除きたい場合は、事前に Trim などで表記をそろえておきます。

• 残るのは上の行。残したい行が上に来るよう先に並べ替える
• 空白や全角・半角の違いは重複とみなされない
• Columns に指定する Array は判定に使う列番号（表の左端を1とする）

実行前の確認

削除した行は、マクロを実行した後に「元に戻す」で戻すことができません。最初は対象のシートをコピーしてから試し、削除件数が想定どおりかを確認してから本番のデータに使うと安心です。削除した件数をメッセージで表示しておくと、想定と大きく違う場合にすぐ気づけます。

ほかの記事