VBAを使用して、Excelのシートに重複データが存在するか調べてみます。
VBAで重複データの確認
Sheet1のA列とB列にデータが入力されています。
A列は文字Eが重複していますが
B列に重複している文字は存在しません。
VBAで重複データがあるか確認するには
Dictionaryオブジェクトを使用します。
Dictionaryオブジェクトを使用するには
Microsoft Scripting Runtimeに参照設定を行う必要があります。
参照設定についてはこちらをご覧ください。
重複データの存在を確認をするコードです。
|
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 |
Option Explicit Sub findDupulicates(sht As Worksheet, col As Long) '################################################################################### '指定した列に重複データが存在するか確認する '----------------------------------------------------------------------------------- '引数 :sht 重複データが存在するか確認したいシート ' :col 重複データが存在するか確認したい列 '################################################################################### Dim dic As Dictionary Set dic = New Dictionary Dim lastRow As Long lastRow = getMaxRow(sht, col) Dim dupulicateFlag As Boolean dupulicateFlag = False Dim i As Long For i = 1 To lastRow If dic.Exists(sht.Cells(i, col).Value) Then dupulicateFlag = True Else dic.Add sht.Cells(i, col).Value, sht.Cells(i, col).Value End If Next i If dupulicateFlag Then MsgBox "重複しているデータが存在します", vbInformation, "重複データあり" Else MsgBox "重複しているデータは存在しません", vbInformation, "重複データなし" End If Set dic = Nothing End Sub Function getMaxRow(sht As Worksheet, targetCol As Long) As Long getMaxRow = sht.Cells(sht.Rows.Count, targetCol).End(xlUp).Row End Function |
データの最終行を取得するためにgetMaxRowを使用しています。
|
19 20 21 22 23 24 25 |
For i = 1 To lastRow If dic.Exists(sht.Cells(i, col).Value) Then dupulicateFlag = True Else dic.Add sht.Cells(i, col).Value, sht.Cells(i, col).Value End If Next i |
DictionaryのExistsメソッドとAddメソッドでcells(i, col).Valueと入力しています。
cells(i, col)とValueの入力を省略してしまうと
セルの値ではなくRangeオブジェクトが呼び出されます。
重複チェックが動かなくなってしまうので、必ずValueをつけてください。
test_findDupulicatesを実行するとfindDuplicatesを呼び出して
A列とB列に重複データがあるか確認します。
|
1 2 3 4 5 6 7 8 9 10 11 12 |
Option Explicit Sub test_findDupulicates() Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets("Sheet1") Call findDupulicates(sht, 1) Call findDupulicates(sht, 2) Set sht = Nothing End Sub |
Call findDupulicates(sht, 1)でA列に重複データがあるか確認しています。
文字Eが重複しているので、メッセージボックスに重複データが存在すると
表示されます。
Call findDupulicates(sht, 2)でB列に重複データがあるか確認しています。
重複している文字はないので、重複データなしと表示されます。
VBAで重複しているデータを取得
VBAでExcelのシートの重複データを取得するには、Dictionaryオブジェクトを使用します。
Dictionaryオブジェクトを使用するには
Microsoft Scripting Runtimeに参照設定を行う必要があります。
Sheet2のA列に都道府県を一部抜粋したデータを入力しました。
データが少ないので目視でも確認できますが、千葉県と奈良県が重複しています。
VBAを使用して重複データを取得します。
重複データを取得するコード
シートの特定の列から重複データを取得するコードです。
|
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 45 |
Option Explicit Function listDupulicates(sht As Worksheet, col As Long) As Dictionary '################################################################################### '指定した列の重複データをDictionaryとして返す '----------------------------------------------------------------------------------- '引数 :sht 重複データを取り出したいしたいシート ' :col 重複データが取り出したい列番号 '戻り値:重複しているデータのDictionary '################################################################################### Dim dic As Dictionary Set dic = New Dictionary Dim lastRow As Long lastRow = getMaxRow(sht, col) Dim i As Long For i = 1 To lastRow If dic.Exists(sht.Cells(i, col).Value) Then 'Dictionaryに項目が存在するときはフラグをTrueにする dic(sht.Cells(i, col).Value) = True Else dic.Add sht.Cells(i, col).Value, False End If Next i Dim duplicateDic As Dictionary Set duplicateDic = New Dictionary For i = 0 To dic.Count - 1 '重複している項目をdicからduplicateDicにコピーする If dic(dic.Keys(i)) Then duplicateDic.Add dic.Keys(i), True End If Next i Set listDupulicates = duplicateDic Set dic = Nothing Set duplicateDic = Nothing End Function Function getMaxRow(sht As Worksheet, targetCol As Long) As Long getMaxRow = sht.Cells(sht.Rows.Count, targetCol).End(xlUp).Row End Function |
データの最終行を取得するためにgetMaxRowを使用しています。
listDupulicatesプロシージャーはシートオブジェクトと重複データが存在する列を指定すると
重複データをDictionaryオブジェクトとして返します。
test_listDuplicatesを動かすと、重複データをSheet2のB列に書き出します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
Sub test_listDupulicates() Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets("Sheet2") Dim duplicateDic As Dictionary Set duplicateDic = listDupulicates(sht, 1) 'Sheet2の1列目の重複データを取得します Dim i As Long For i = 0 To duplicateDic.Count - 1 'Sheet2の2列目に重複データを書き出します sht.Cells(i + 1, 2) = duplicateDic.Keys(i) Next i Set duplicateDic = Nothing Set sht = Nothing End Sub |
重複データを削除する
VBAを使用せず、手っ取り早くシートから重複データを削除したいときは
Excelのデータタブにある「重複の削除」を使用することをおすすめします。
VBAを使用する場合はRangeオブジェクトのRemoveDuplicates メソッドを使用します。
Sheet2に都道府県のデータを入力しましたが、千葉県と奈良県が重複しています。
重複している千葉県と奈良県のデータを削除します。
シートから重複データを削除するコードです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Option Explicit Sub deleteDupulicates() Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets("Sheet2") Dim lastRow As Long lastRow = getMaxRow(sht, 1) '1列目の最終行を取得します sht.Range("A1:A" & lastRow).RemoveDuplicates Columns:=Array(1), Header:=xlYes Set sht = Nothing End Sub Function getMaxRow(sht As Worksheet, targetCol As Long) As Long getMaxRow = sht.Cells(sht.Rows.Count, targetCol).End(xlUp).Row End Function |
データの最終行を取得するためにgetMaxRowを使用しています。
deleteDuplicatesを実行すると、重複している千葉県と奈良県のデータが削除されます。
コメント