指定セル範囲からDictionaryオブジェクトを作成する

コードコピー

Function zzz辞書作成(ByVal hzzセル範囲 As Range, Optional ByVal hzzオフセット列数 As Long = 0) As Object
Dim zz辞書 As Object: Set zz辞書 = CreateObject("Scripting.Dictionary")
Dim zz対象セル As Range


For Each zz対象セル In hzzセル範囲
    If zz対象セル <> "" Then
        If zz辞書.Exists(zz対象セル.Text) = False Then
            zz辞書.Add zz対象セル.Text, zz対象セル.Offset(0, hzzオフセット列数).Text
        Else: End If
    Else: End If
Next zz対象セル

If zz辞書.Count <> 0 Then
    Set zzz辞書作成 = zz辞書
Else: End If
Set zz辞書 = Nothing


End Function

ですが、これを作成する場合は、インスタンスの作成からデータの取得までを行う必要があります
これが作成のたびに作るのが案外面倒なので処理化しました

この関数を実行すると、引数に指定したセル範囲のデータからDictionaryオブジェクトのリストを作成して、そのDictionaryオブジェクトを返します
なお、取得したアイテムが無ければNothingを返します

目的とは少し違ってきますが、Dictionaryオブジェクト自体が重複不可なリストを作成しますので、セル範囲のデータから重複しないデータのリストを作成することも可能です

なお、この関数では取得するデータは全て文字列として取得されます

「hzzセル範囲」は取得を行うセル範囲を指定します
いちおう複数列は指定可能ですが、次のオフセット列数を指定する場合はその分列がずれていく点には注意が必要です

「hzzオフセット列数」は指定したセル範囲のデータをitemとして取得するかどうかを設定するための数値です
引数に指定したセル範囲のデータをitemとして取得してよければ省略してください
オフセット数値なので負の数値も設定可能ですが、指定セル範囲から参照できない数値を指定した場合は実行時エラーが発生します

関数の使用例

Dim zz辞書 As Object
Set zz辞書 = zzz辞書作成(Range("A2:A10"), 1)
If zz辞書 Is Nothing Then
Exit Sub
Else: End If

Dim zz取得キー As Variant
For Each zz取得キー In zz辞書.Keys
Debug.Print zz辞書(zz取得キー)
Next zz取得キー

実際に使用する場合は、戻り値を代入させる変数の宣言を行っておく必要があります
また、この変数の型は戻り値の型がObject型なので合わせておいてください

引数には指定セル範囲がA1～A10までの10個のセルを指定
オフセット数値に1を指定していますので、itemはB1～B10の内容が取得されることになります

セル範囲をB1~B10にして、数値を-1に指定すれば、B列がkeyとなりA列がitemとなるDictionaryオブジェクトの作成が可能です

上記に記載しましたが、この関数は取得したアイテムの数は0個の場合にはNothingを返しますので、その判定を一応行っています
その場合には処理を終了しています

コード解説

Function zzz辞書作成(ByVal hzzセル範囲 As Range, Optional ByVal hzzオフセット列数 As Long = 0) As Object

～～中略～～

End Function

戻り値として、作成したDictionaryオブジェクトを返すのでFunctionプロシージャとして作成をしています
また、返すのはDictionaryオブジェクトですがバインディングが必要な型になるので、汎用的なObject型として指定しています

そのため、この関数の戻り値を代入させる変数も同じ型にしておいてください

Dim zz辞書 As Object: Set zz辞書 = CreateObject("Scripting.Dictionary")
Dim zz対象セル As Range

関数内で使用する変数の宣言です
使用する変数は2つになります

1つ目はDictionaryオブジェクトです
事前バインディングは行わず、実行時バインディングを行っています
なので、変数の型はObject型となります
変数の宣言後、すぐにインスタンスの作成を行っています
特に処理の実行条件確認は行っていないためです

2つ目は引数のセル範囲をループさせるためのセル変数です

For Each zz対象セル In hzzセル範囲

～～中略～～

Next zz対象セル

引数のセル範囲を全てループします
セルはオブジェクトなので、For Eachループを使用してすべてのセルを1つ1つ参照していきます

    If zz対象セル <> "" Then

～～中略～～

    Else: End If

セルの入力値が空白であれば取得は行いません
そもそも空白のデータというものが、空白というデータなのかデータが無いというのかを判定するのは面倒ですし、何より引数に指定するセル範囲に空白が存在しないようにするもの面倒です

なので、前提として空白は取得を行いません

        If zz辞書.Exists(zz対象セル.Text) = False Then
            zz辞書.Add zz対象セル.Text, zz対象セル.Offset(0, hzzオフセット列数).Text
        Else: End If

次にDictionaryオブジェクトにデータを取得させるには、すでに存在するkeyは取得できないので、データの存在確認を行います
ExistsメソッドによりFalseが返された場合にのみ取得を行います

取得する際にkeyはループ参照しているセルのTextプロパティを取得させます
keyは代入させられる型がセルほどにありません
文字列と数値で同じ見た目でも別の値と認識されて、itemが取得できなくなるので前提として統一しておいた方が後で取り出しやすくなります
なので、この関数では全てのデータは文字列として取得させています

itemは参照セルからオフセット数値を列移動させたデータを取得させます
オフセット数値が省略時は0が指定されるので、移動しないので参照セルを取得する形になります
つまりkeyとitemが同じものが取得されることになります
こちらもkey同様にTextプロパティを取得しています

If zz辞書.Count <> 0 Then
    Set zzz辞書作成 = zz辞書
Else: End If
Set zz辞書 = Nothing

指定セル範囲からリストの作成が完成したら、最後にそのDictionaryオブジェクトをFunctionプロシージャの戻り値に設定します

しかし、そもそもitemが全くないDictionaryオブジェクトを返しても意味は無いので、item数をCountプロパティから取得してその個数が0でなければ戻り値に代入します

0であれば戻り値に代入しませんので、Object型の初期値であるNothingが返されることになります

これで、この関数の戻り値がNothingかどうかを判定することでitemの有無を判定させることが出来ます

最後に使用したObject型変数の解放を行っています

この関数を使用すれば、Dictionaryオブジェクトを使用する際にインスタンスの作成を自分で作成する必要が無いので文字列型で問題なければ有効に利用できます