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