EXCEL VBA 重複データを削除・チェック・抽出・別シート（RemoveDuplicates メソッド）
EXCEL VBA 重複データを削除・チェック・抽出・別シート（RemoveDuplicates メソッド）
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行目のヘッダーを設定）
重複データを削除・複数条件・複数項目 （RemoveDuplicates メソッド）①
下記のサンプルプログラムは、EXCELデータに同じ重複データを削除するサンプルプログラムです。サンプルデータの項目として、日付・勘定科目・金額・担当者の４項目が有り、4つの４項目がすべて同じ重複データを削除します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
' '******** 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 ' |
（画面クリックして拡大）
重複データを削除・複数条件・複数項目・チェック （RemoveDuplicates メソッド）②
下記のサンプルプログラムは、サンプル①のサンプルプログラムの応用になります。今回のプログラムは、重複データを削除する前に、チェック項目に「重複」を表示します。そのチェック項目の内容で重複データを削除が判断します。
【プログラム実行の流れ】
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
' '******** 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 ' |
（画面クリックして拡大）
重複データを削除・複数条件・複数項目・チェック・別シート （RemoveDuplicates メソッド）③
下記のサンプルプログラムは、サンプル①と②のサンプルプログラムの応用になります。今回のプログラムは、重複した削除データを別シートに記載するサンプルプログラムです。元のデータを保管する時や、プログラムを何度も実行する場合は、このように、データを別シートに転記して処理を実行する方が何度も繰り返して処理を実行する事ができます。
【プログラムの流れ】
【プログラム実行条件】
・ワークシート名「DATA」 ・・・重複データのある「氏名データ」一覧がある。
・ワークシート名「一覧」 ・・・重複データを削除して「氏名データ」が作成されます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
' '******** 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 ' |
（画面クリックして拡大）
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。