EXCEL VBA 重複データをチェック・抽出・別シート・メッセージ（テクニック）
●はじめに
EXCELでデータの一覧表などを作成し、入力したデータに対して重複データをチェックし、別の列に一意の一覧表を作成したり、別のシートに作成する方法などを説明いたします。EXCELデータを目視で重複データをチェックするのは、データ件数が数百件・数千件となると目視では、困難なためVBAプログラムを使い、素早くかつ正確に作成する必要があります。下記にサンプルプログラムを３パターン作成しましたので、参考に利用して下さい。
●プログラム説明 サンプルプログラム①（重複データから一意データの抽出）
下記のプログラムは、同一列内の重複データから一意のデータを抽出するプログラムです。Sheet１のA列に業者名の重複データの一覧があります。その中から一意のデータをSheet１のE列に業者名の一覧を作成します。
※下記のプログラムは、シート名が、「Sheet１」で実行出来るように作成しています。他のシート名の場合は、エラーがは発生します。
Sub Jyuufuku01()
Dim ws01 As Worksheet
Dim HIKAKU As Range
Dim KEN01, JYUUFUKU, i As Long
Set ws01 = Worksheets("Sheet1") 'ワークシートの設定
KEN01 = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を設定する
JYUUFUKU = 2
For i = 2 To KEN01
Set HIKAKU = ws01.Columns("E").Find(What:=ws01.Cells(i, "A"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'A列とE列を比較する
If HIKAKU Is Nothing Then '比較して無い場合は、下記を実行
ws01.Cells(JYUUFUKU, "E") = ws01.Cells(i, "A") '追加する文字を転記する。（コード）
JYUUFUKU = JYUUFUKU + 1
End If
Next i 'A列データの最終行までループ
End Sub
●実行結果 サンプルプログラム①（実行後：A列の重複している業者名からE列に一意の業者名が表示されました。）
●プログラム説明 サンプルプログラム②（重複データから一意データの抽出）：New Collectionを使用した場合
下記のプログラムは、上記のプログラムと実行結果は、同じになりますが、New Collectionを使ったプログラムになります。処理内容は同じですが、同一列内の重複データから一意のデータを抽出するプログラムです。Sheet１のA列に業者名の重複データの一覧があります。その中から一意のデータをSheet１のE列に業者名の一覧を作成します。
※下記のプログラムは、シート名が、「Sheet１」で実行出来るように作成しています。他のシート名の場合は、エラーがは発生します。
Sub jyuufuku02()
Dim Corp As New Collection
Dim i, mRow As Long
Dim ws01 As Worksheet
Set ws01 = Worksheets("Sheet1") 'ワークシートの設定
mRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を設定
On Error Resume Next 'エラーが発生しても続行する。
For i = 2 To mRow 'A列の最終行データまで繰り返す
Corp.Add ws01.Cells(i, "A"), ws01.Cells(i, "A") 'コレクションに追記
Next i
On Error GoTo 0
For i = 1 To Corp.Count 'コレクションデータ最終件数まで繰り返す
ws01.Cells(i + 1, "E") = Corp(i) 'コレクションデータを順番に取り出す。
Next i
End Sub
●実行結果 サンプルプログラム②（A列の重複データから一意データをE列に抽出）：New Collectionを使った場合の結果
●プログラム説明 サンプルプログラム③（重複データから一意データの抽出し、別シートに転記）
下記のプログラムは、サンプルプログラム①・②と同じ様に、重複データから一意のデータを抽出するプログラムですが、シート結果を別シート（Sheet2）に一意のデータを表示させます。なお、元データ（Sheet1）については、重複データが分かる様に該当するセルの背景色が青色に塗りつぶしされます。処理後には、重複件数をメッセージボックスで表示させます。
※下記のプログラムは、シート名が、「Sheet１」と「Sheet2」で実行出来るように作成しています。他のシート名の場合は、エラーがは発生します。
Sub Jyuufuku03()
Dim ws01, ws02 As Worksheet
Dim HIKAKU As Range
Dim KEN01, JYUUFUKU, JYUUFUKU_COUNT, i As Long
Set ws01 = Worksheets("Sheet1") 'ワークシートの設定(元のデータ)
Set ws02 = Worksheets("Sheet2") 'ワークシートの設定（結果）
KEN01 = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を設定する
JYUUFUKU = 2
JYUUFUKU_COUNT = 0
For i = 2 To KEN01
Set HIKAKU = ws02.Columns("A").Find(What:=ws01.Cells(i, "A"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'シート１：A列とシート２：A列を比較する
If HIKAKU Is Nothing Then '比較して無い場合は、下記を実行
ws02.Cells(JYUUFUKU, "A") = ws01.Cells(i, "A") '追加する文字を転記する。（コード）
ws02.Cells(JYUUFUKU, "B") = ws01.Cells(i, "B")
ws02.Cells(JYUUFUKU, "C") = ws01.Cells(i, "C")
JYUUFUKU = JYUUFUKU + 1
Else
ws01.Range("A" & i & ":C" & i).Interior.ColorIndex = 41 '重複する該当セルを青で塗りつぶします。
JYUUFUKU_COUNT = JYUUFUKU_COUNT + 1 '重複件数をカウントする
End If
Next i 'A列データの最終行までループ
MsgBox "重複した件数は" & JYUUFUKU_COUNT & "件です。"
End Sub
●実行結果 サンプルプログラム③ （Sheet1のA列の重複データに青色の背景色が塗られます。Sheet2のA列に業者名の一意データが表示され、重複された件数が表示されます。 ）
最後まで、ご覧いただきまして誠に有難うございました。
今回は、EXCELデータの重複データ処理についての一意データ抽出方法などの説明でした。
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。
