VBAを使用して、Excelのシートに重複データが存在するか調べてみます。
VBAで重複データの確認 #
Sheet1のA列とB列にデータが入力されています。
A列は文字Eが重複していますがB列に重複している文字は存在しません。
VBAで重複データがあるか確認するにはDictionaryオブジェクトを使用します。
Dictionaryを使用するにはMicrosoft Scripting Runtimeに参照設定を行う必要があります。
参照設定についてはこちらをご覧ください。
Dictionaryを使用して重複データの存在を確認をするコードです。
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を使用しています。
getMaxRowの使用方法についてはこちらをご覧ください。
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列に重複データがあるか確認します。
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を使用して重複データを取得します。
重複データを取得するコード #
シートの特定の列から重複データを取得するコードです。
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列に書き出します。
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に都道府県のデータを入力しましたが、千葉県と奈良県が重複しています。
重複している千葉県と奈良県のデータを削除します。
シートから重複データを削除するコードです。
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を実行すると、重複している千葉県と奈良県のデータが削除されます。
