ie-excel

エクセル・マクロでie操作

重複削除

Dictionary オブジェクト

Dictionary オブジェクトを使うことにより、キーを設定することが可能です。
このキーをユニークとなるため、重複削除されたデータを作成することが可能です。
このDictionary オブジェクトを使用することにより、重複削除された表を作ることが可能となります。
なおこのDictionary オブジェクトはキーと項目、それぞれをひとずつしか設定できません。
そのため、複数キーがある場合には工夫が必要です。

キーが1項目のデータを重複削除し、項目数を数える

キーが1項目のみで、その項目の件数をカウントする場合は以下のコードで取得可能です。


Sub 重複削除()
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
This_Sheet.Name = "Sheet1"
MaxRow = This_Sheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To MaxRow
myKey = This_Sheet.Cells(i, 1).Value
If Not myDic.Exists(myKey) Then
myDic.Add myKey, 1
Else
myDic(myKey) = myDic(myKey) + 1
End If
Next i
End Sub

上記コードを簡単に説明します。

Scripting.Dictionaryを参照する


Scripting.Dictionaryを参照する方法は二つあります。
「ツール」→「参照設定」で、Microsoft Scripting Runtimeを参照する方法
参照設定しなくとも、以下のコードで参照が可能となります。

Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")

重複データがないことをチェック

重複データをExistsメソッドを用いて検索
 存在しなければ、Addメソッドを使用してキーを新たに追加
 存在すればカウントアップ


If Not myDic.Exists(myKey) Then
myDic.Add myKey, 1
Else
myDic(myKey) = myDic(myKey) + 1
End If

キーが1項目のデータを重複削除し、列2を累計する

上記例示で、項目に対して2列目を加えています。


Sub 重複削除()
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
This_Sheet.Name = "Sheet1"
MaxRow = This_Sheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To MaxRow
myKey = This_Sheet.Cells(i, 1).Value
If Not myDic.Exists(myKey) Then
myDic.Add myKey, This_Sheet.Cells(i, 2).Value
Else
myDic(myKey) = myDic(myKey) + This_Sheet.Cells(i, 2).Value
End If
Next i
End Sub

キーが複数ある場合、列3を累計する

上記例示で、キーが複数ある場合はキーを連結してキーを作ります。
連結することによって、他のデータと重複しないよう、ここでは連結する際に「||」を挿入しています。


Sub 重複削除()
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
This_Sheet.Name = "Sheet1"
MaxRow = This_Sheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To MaxRow
myKey = This_Sheet.Cells(i, 1).Value & "||" & This_Sheet.Cells(i, 2).Value
If Not myDic.Exists(myKey) Then
myDic.Add myKey, This_Sheet.Cells(i, 3).Value
Else
myDic(myKey) = myDic(myKey) + This_Sheet.Cells(i, 3).Value
End If
Next i
End Sub

-VBA