辞書で簡単に重複を見つける
辞書（Dictionary）は重複を許さないので、辞書による重複排除は良く使われる手法です。辞書の使い方については、以下のページで説明しています。
・辞書の解説ページ
これとは別に少々トリッキーな方法があるようなので紹介します。
（くれぐれも辞書の基本的な使い方をマスターしてから使いましょう。）
プログラムコード
Sub dicTestCode()
Dim i As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'重複があれば増加
dic(Cells(i, "A").Value) = dic(Cells(i, "A").Value) + 1
Next
'/// 辞書の中身 ///
Dim val As Variant
For Each val In dic.Keys
Debug.Print "key=" & val & ":値=" & dic(val)
Next
'//////////////////
End Sub
結果は以下のようになります。
key=りんご:値=4
key=いちご:値=1
key=ばなな:値=4
key=みかん:値=4
プログラム解説
まず、辞書を使う場合は、Valueを省略してはいけないので注意しましょう。
キモとなるのは以下の部分となります。
dic(Cells(i, “A”).Value) = dic(Cells(i, “A”).Value) + 1
まずは右辺ですが、Addしていないにも関わらず、セルのキー（セルの値）要素が無ければ勝手にAddしています。
さらに辞書の値に関しては、１を追加していますので０で初期化されていたと考えられます。
そして、左辺ですが、
dic( キー ) = 値
で値をセットできます。右辺は１ですので、そのまま値が入ることになります。
i = i + 1 という書き方は見慣れていると思いますが、i = 0 などと必ず初期化が必要です。
しかし、辞書の場合は初期化が自動で行われるようで、いきなりこのような書き方ができるようです。
応用プログラム
今回の辞書には、キーにセルの文字列、値に重複数が入っていますので、重複のないリストや重複要素、重複なし要素が簡単に取り出せます。
以下のコードを参照してください。
Sub dicTestCode1()
Dim i As Long, j As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
dic(Cells(i, "A").Value) = dic(Cells(i, "A").Value) + 1 '重複があれば値を増加
Next
'重複なしのリスト
Range("C1") = "重複なしのリスト"
Dim val As Variant
i = 2
For Each val In dic.Keys
Cells(i, "C") = val
i = i + 1
Next
'重複している要素のリスト、重複していない要素のリスト
Range("E1") = "重複要素"
Range("G1") = "重複なし要素"
i = 2
j = 2
For Each val In dic.Keys
If dic(val) > 1 Then
Cells(i, "E") = val
i = i + 1
Else
Cells(j, "G") = val
j = j + 1
End If
Next
End Sub結果は以下のようになります。
まとめ
重複を探すようなコードでは、結構短い行数で書けるので重宝するかと思います。
ただ、やはり辞書の基本的な使い方を理解してから使用した方が良いと感じます。
コメント