同じ表の中で、重複するデータがあれば削除するというケースがありました。

今回はExcelの機能である重複の削除を使わず重複の削除を実現しようと思います。

 

やりたいこと

以下の画像をご覧ください。重複するデータがいくつかあります。

この時、一番最初に出てくる氏名を残し、二回目以降に出てくる氏名を削除するというコードを削除したいと思います。

 

つまり、↑の赤線で引いてある３のジンだけを残すということです。

工藤新一も重複してますが、分かりやすいようにジンで見てみましょう。

 

ポイントは、

  • 一番上の氏名を残す。
  • ヘッダー行よりも上に空白行がある

ということくらいでしょうか

 

重複を削除するVBAコード

早速VBAコードを記載します。

Sub remove_duplicate()
    Dim ws As Worksheet
    Dim endRow, nameCnt As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 最終行を取得(氏名)
    endRow = ws.Cells(Rows.Count, 3).End(xlUp).Row
    ' 開始行を指定
    Const beginRow = 4
    ' ループ
    For nameCnt = beginRow To endRow
        ' 氏名を検索し、今までに出てきたことのある氏名なら削除する
        If WorksheetFunction.CountIfs(ws.Range("C" & beginRow & ":C" & nameCnt), ws.Range("C" & nameCnt).Value) >= 2 And ws.Range("C" & nameCnt).Value <> "" Then
            ' 行削除
            ws.Rows(nameCnt).Delete shift:=xlUp
            ' 行削除で行番号が変更されたため、イテレータと最終行をカウントダウン
            nameCnt = nameCnt - 1
            endRow = endRow - 1
        End If
    Next nameCnt
End Sub

 

本処理はループと記載がある部分です。こちらのコードを実行すると、以下のようになります。（実行前後を記載します）

実行前

 

実行後

７，９のジン、８の工藤新一が削除されていることが分かります。

 

解説

このコードの肝は、Countifsです！！まず、以下の表の重複を判定するために、エクセルの関数のCountifsを使ってみます。

以下のF列では、C4から現在の行までの範囲から現在の行の氏名がいくつあるか？を表示しています。

 

関数を見てみましょう。#7のジンの数式では、氏名の一番上から現在の行までを範囲として、「ジン」がいくつあるかを表示しています。

 

元の画像に戻ります。つまり、２以上の行については重複行ということが分かりますね。

２以上となる行について、行削除を行えばよいというわけです。

 

コードに戻ると、WorksheetFunction の Countifs メソッドを前述のエクセルの関数と同じように使っているのが分かります。このコードがすべてなのです。

 

あとは、対象行を削除し、行削除したことで影響するループ中の変数（イテレータ）の数を調整しています。

 

さいごに

いかがでしたでしょうか？重複を削除するコードとしてはシンプルかなと思います。

ここではワークシートファンクションをうまく使うということを意識して、他にも活用できることを理解いただければよいかなと思います！

 

ではまた！