Collectionで重複なしリストを作成する

Collectionで重複のないユニークリストを作成する方法を解説します。

重複チェックはCollectionの標準機能にはありませんので、

• KeyにItemと同じものを入れてKeyを重複チェックに利用する
• Itemの存在チェック関数を自作して対応する

このいずれかの方法で対応します。

はじめに～Dictionaryオブジェクトについて

Collectionと似た仕組みで、Dictionary(連想配列)というものがあります。

このDictionaryには「Existsメソッド」がありますので、
Collectionとは異なり要素の存在チェックが一発で終わります。

また、Dictionaryには「一次元配列(Array)に変換する」という、
これもCollectionにはない便利な機能を有しています。

出来上がったユニークリストを配列にしたりセルに出力する場合も、
CollectionよりDictionaryの方が優れていることになります。

本記事のコードは

• すでにCollectionで書かれたコードの改修を行う必要がある
• Dictionaryが使えない環境（MacのPCなど）で組む必要がある

場合のためのものと思ってください。

これから組むマクロであれば、
以下の記事を参考にDictionaryで実装するのをおすすめします。

KeyにItemと同じものを入れて重複チェックを行うコード

ソースコード

Sub A列のデータを重複をなくしてCollectionに格納する()

    Dim Clct商品リスト As New Collection

    Dim wsデータ As Worksheet: Set wsデータ = Worksheets("○○")
    Dim 最終行 As Long
    最終行 = wsデータ.UsedRange.Rows.Count + wsデータ.UsedRange.Row - 1
    
    ' データの全行をループ
    Dim R As Long
    For R = 2 To 最終行
    
        ' エラースキップ下でKeyとItemに同じものを指定した要素をAdd
        On Error Resume Next
        Clct商品リスト.Add wsデータ.Cells(R, 1).Value, wsデータ.Cells(R, 1).Value
        On Error GoTo 0
        
    Next
   
    ' 出力テスト
    Dim 商品名
    For Each 商品名 In Clct商品リスト
        Debug.Print 商品名
    Next
   
End Sub

解説

Collectionに要素を格納するAddメソッドは、
第2引数でKeyを指定することができます。

このKeyは重複を許さず、もし重複した場合は、

実行時エラー '457': このキーは既にこのコレクションの要素に割り当てられています。

エラーが発生します。

この仕様を活用し、On Error Resume Next下でAddメソッドを動かすことで、
重複の無い（未登録の）KeyだけをCollectionに格納することができます。

これで重複の無いKeyリストを登録することはできるのですが、

• CollectionはItemを省略することができない
• CollectionはKeyのリストを取得することができない

という仕様のため、ItemにもKeyと同じものを入れて対応することになります。

Item、KeyともにRangeを渡すとRangeがそのまま入ってしまいますので、
「.Value」の書き忘れに十分注意してください。

重ねてになりますが、これがDictioanryであれば、

• 重複チェックはエラー処理をしなくてもExistsメソッドで一発
• Itemは省略はできないが""で無視することは可能
• 出来上がったKeyのリストは取り出せる上に一次元配列にもできる

と、Collectionの完全上位互換と言っていいオブジェクトですので、
よほどの理由がなければDictionaryで実装するのをおすすめします。

Itemの存在チェック関数を自作して対応するコード

ソースコード

Sub A列のデータを重複をなくしてCollectionに格納する2()

    Dim Clct商品リスト As New Collection

    Dim wsデータ As Worksheet: Set wsデータ = Worksheets("○○")
    Dim 最終行 As Long
    最終行 = wsデータ.UsedRange.Rows.Count + wsデータ.UsedRange.Row - 1
    
    ' データの全行をループ
    Dim R As Long
    For R = 2 To 最終行
    
        ' 未登録のItemだけをCollectionに格納
        If IsCollection内に要素が存在(Clct商品リスト, wsデータ.Cells(R, 1).Value) = False Then
            Clct商品リスト.Add wsデータ.Cells(R, 1).Value
        End If
        
    Next
   
    ' 出力テスト
    Dim 商品名
    For Each 商品名 In Clct商品リスト
        Debug.Print 商品名
    Next
   
End Sub

' Collectionの要素存在チェック関数
Function IsCollection内に要素が存在(コレクション As Collection, 判定値 As Variant) As Boolean

    Dim 要素
    For Each 要素 In コレクション
    
        If 要素 = 判定値 Then
            IsCollection内に要素が存在 = True
            Exit Function
        End If
    
    Next
    
End Function

解説

コレクションにあるItemが存在するかどうかは、
中身をFor Eachで調べて回るしかありません。

これをいちいちメインコード内でやるとループが複雑怪奇になるので、
汎用関数を作って対応しています。

その分メインコードはわかりやすいIf文で書かれており、

' 未登録のItemだけをCollectionに格納
If IsCollection内に要素が存在(Clct商品リスト, wsデータ.Cells(R, 1).Value) = False Then
    Clct商品リスト.Add wsデータ.Cells(R, 1).Value
End If

このように「要素がなかったらAdd」というシンプルなコードになっていますね。

KeyとItemに同じものを入れる手法より手間はかかりますが、
他のエラー処理があってOn Error Resume Nextを使えない場合など、
状況に応じてこちらの使用も検討してください。

詳しくはこちらの記事をどうぞ
www.limecode.jp