EXCELファイルを複数のユーザーで共用利用してデータを登録すると、複数のユーザーでデータを入力する事で、誤ってデータを重複登録する事もあると思います。この場合、データ量が少ない場合は、目視で探す事が出来ると思いますが、100件以上となると重複したデータを探しきれないので、【RemoveDuplicates メソッド】を利用する事で簡単に重複データを削除する事が出来ます。今回は、３つのサンプルプログラムを作成しましたので、順番に説明いたします。
【指定した範囲から重複したデータを削除します。】
● Rangeオブジェクト.RemoveDuplicates ( Columns , Header )
・Columns:列 （重複対象の列）・（設定必須）
・Header：行 （ヘッダーの設定）・（省略可能）
| 定数【Header】 | 値 | 内容（説明） |
|---|---|---|
| xlGuess | 0 | EXCELに範囲内の１行目をヘッダーにするか判断してもらう。 |
| xlYes | 1 | 範囲内の１行目をヘッダーにする。 |
| xlNo | 2 | 範囲内の１行目をヘッダーにしない。 |
●『使用例』
Range(“A1:C16”).RemoveDuplicates Columns:=2, Header:=xlYes
※（セルA1:C10の範囲内で、２列目（B列）の重複行を削除・1行目のヘッダーを設定）
下記のサンプルプログラムは、EXCELデータに同じ重複データを削除するサンプルプログラムです。サンプルデータの項目として、日付・勘定科目・金額・担当者の４項目が有り、4つの４項目がすべて同じ重複データを削除します。
'
'******** AKIRA55.COM ******* https://akira55.com/jyuufuku02/
'
Sub 重複01() '重複しているデータを削除
Dim lRow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row 'データの最終行を取得
Range("A1:D" & lRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes '重複しているデータを削除
End Sub
'
下記のサンプルプログラムは、サンプル①のサンプルプログラムの応用になります。今回のプログラムは、重複データを削除する前に、チェック項目に「重複」を表示します。そのチェック項目の内容で重複データを削除が判断します。
【プログラム実行の流れ】
'
'******** AKIRA55.COM ******* https://akira55.com/jyuufuku02/
'
Sub 重複02() '重複データを削除します。
Dim I, lRow As Long
Dim CK As Integer
lRow = Cells(Rows.Count, "A").End(xlUp).Row 'データの最終行を取得
For I = 2 To lRow 'データの最終行まで繰り返します。
If WorksheetFunction.CountIfs(Range("A2:A" & lRow), Range("A" & I), Range("B2:B" & lRow), Range("B" & I), _
Range("C2:C" & lRow), Range("C" & I), Range("D2:D" & lRow), Range("D" & I)) > 1 Then
'CountIFs関数を使い、重複データを検索します。４つの項目とも同じデータが２つ以上ある場合は、２以上の数値を返します。
Cells(I, "E") = "重複" '重複データの場合は、チェック項目に「重複」と記入します。
Cells(I, "E").Font.ColorIndex = 3 'チェック項目の「重複」を赤色にします。
End If
Next I
CK = MsgBox("データを削除しますか？", vbYesNo + vbQuestion, "確認") '重複データを削除するか判断します。
If CK = vbYes Then
Range("A1:E" & lRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes '重複しているデータを削除
Else
MsgBox "キャンセルしました。"
End If
End Sub
'
下記のサンプルプログラムは、サンプル①と②のサンプルプログラムの応用になります。今回のプログラムは、重複した削除データを別シートに記載するサンプルプログラムです。元のデータを保管する時や、プログラムを何度も実行する場合は、このように、データを別シートに転記して処理を実行する方が何度も繰り返して処理を実行する事ができます。
【プログラムの流れ】
【プログラム実行条件】
・ワークシート名「DATA」 ・・・重複データのある「氏名データ」一覧がある。
・ワークシート名「一覧」 ・・・重複データを削除して「氏名データ」が作成されます。
'
'******** AKIRA55.COM ******* https://akira55.com/jyuufuku02/
'
Sub 重複削除03() '別シートに転記して重複データを削除する
Dim ws01, ws02 As Worksheet
Dim I, lRow, mRow As Long
Dim CK As Integer
Set ws01 = Worksheets("DATA")
Set ws02 = Worksheets("一覧")
lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'シート「DATA」のA列最終行を取得
mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'シート「一覧」のA列最終行を取得
ws02.Cells.Clear 'シート「一覧」を削除します。
For I = 2 To lRow 'シート「DATA」A列の最終行まで繰り返します。
If WorksheetFunction.CountIfs(ws01.Range("A2:A" & lRow), ws01.Range("A" & I), ws01.Range("B2:B" & lRow), ws01.Range("B" & I), _
ws01.Range("C2:C" & lRow), ws01.Range("C" & I), ws01.Range("D2:D" & lRow), ws01.Range("D" & I)) > 1 Then
'CountIFs関数を使い、重複データを検索します。４つの項目とも同じデータが２つ以上ある場合は、２以上の数値を返します。
ws01.Cells(I, "E") = "◎" '重複データの場合は、重複フラグ項目に「◎」と記入します。
End If
Next I
CK = MsgBox("データを削除しますか？", vbYesNo + vbQuestion, "確認") '重複データを削除するか判断します。
If CK = vbYes Then
ws01.Range("A1:D" & lRow).Copy 'シート「DATA」のデータ範囲をコピーします。
ws02.Range("A1").PasteSpecial Paste:=xlPasteAll '選択したデータ範囲(シート「DATA」)を（シート「一覧」）へ張り付ける。
mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'シート「一覧」のA列最終行を取得
ws02.Range("A1:D" & mRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes '重複しているデータを削除
ws02.Activate 'シート「一覧」をアクティブにします。
Else
MsgBox "キャンセルしました。"
End If
End Sub
'
