https://www.limecode.jp/entry/utility/get-dictionary-from-range

セル範囲をDictionaryに格納する方法を解説します。

2つのセル範囲をKey/Itemそれぞれに格納する

まずはこのような表をDictionaryに格納するコードがこちらです。

2列のデータ

Sub セル範囲をDictionaryに格納する()
    
    Dim Dic商品リスト As New Dictionary
    
    ' データ全行をループ
    Dim R As Long
    For R = 2 To WSマスタ.UsedRange.Rows.Count
        
        ' 新出の商品コードであればkey商品コードとitem商品名のペアを格納
        If Dic商品リスト.Exists(WSマスタ.Cells(R, 1).Value) = False Then
            Dic商品リスト.Add WSマスタ.Cells(R, 1).Value _
                            , WSマスタ.Cells(R, 2).Value
        End If
        
    Next
    
    ' 実行テスト
    MsgBox Dic商品リスト(101) ' ←みかんが表示されます。
    
End Sub

対象のキーが存在するかをExistsメソッドで判定し、
存在しなければAddメソッドでペアを追加する基本コードです。

Keys/Itemsを使って一括で行えるセルへの出力と違い、
セルの取込は一括で行うことはできません。

愚直にセル範囲内の全データをループして、
1件ずつデータをDictionaryに追加していってください。

テーブル形式の表データをDictionaryに格納する

続いて以下のような表をDictionaryに格納する方法です。

テーブル形式データ

このデータをDictionaryに取り込む場合は、
以下の二つの方法があります。

Dictionaryを列数分用意する

まずはDictionaryを列数分用意する方法です。

すべてのItemが値のため、ロジックが分かりやすいのが特長です。

Sub テーブル形式データをDictionaryに格納する()
    
    ' 各列ごとにDictionaryを用意
    Dim Dic商品名 As New Dictionary
    Dim Dic種別 As New Dictionary
    Dim Dic価格 As New Dictionary
    
    ' データ全行をループ
    Dim R As Long
    For R = 2 To WSマスタ.UsedRange.Rows.Count
        
        Dim key商品コード As Long
        key商品コード = WSマスタ.Cells(R, 1).Value
        
        ' 新出の商品コードであれば各Dictionaryに登録
        If Dic商品名.Exists(key商品コード) = False Then
            Dic商品名.Add key商品コード, WSマスタ.Cells(R, 2).Value
            Dic種別.Add key商品コード, WSマスタ.Cells(R, 3).Value
            Dic価格.Add key商品コード, WSマスタ.Cells(R, 4).Value
        End If
        
    Next
    
    ' 実行テスト
    MsgBox Dic商品名(101) & "の価格は" & Dic価格(101) & "円です。"
        ' 「みかんの価格は100円です。」が表示されます。
    
End Sub

先ほどのコードと大きく変わらない構造のコードで、
Addメソッドを各Dictionaryで実行するようになっているだけですね。

使用時にはCtrl+SpaceやCtrl+Jの入力候補機能を用いることで、

Dictionaryの選択肢

このリストから選んで入力ができるため、
コーディングもしやすく使い勝手が良いです。

よほど列が多くなければ、この方法で対応してください。

各列を配列としてDictionaryに格納する

続いてデータの各行を1つの配列としてItemに格納する方法です。

列が増えてもDictionaryを増やす必要がなく改修がしやすいですが、
後述の通りこのままではデータの読み取りにしか使えない点にご注意ください。

Sub テーブル形式データをDictionaryに格納する2()
    
    Dim Dic商品リスト As New Dictionary
    
    ' データ全行をループ
    Dim Arr各行(1 To 4)
    Dim R As Long
    For R = 2 To WSマスタ.UsedRange.Rows.Count
        
        Dim key商品コード As Long
        key商品コード = WSマスタ.Cells(R, 1).Value
        
        ' 新出の商品コードであればその行を配列にしてDictionaryに登録
        If Dic商品リスト.Exists(key商品コード) = False Then
            
            Erase Arr各行
            Arr各行(1) = WSマスタ.Cells(R, 1).Value
            Arr各行(2) = WSマスタ.Cells(R, 2).Value
            Arr各行(3) = WSマスタ.Cells(R, 3).Value
            Arr各行(4) = WSマスタ.Cells(R, 4).Value
            
            Dic商品リスト.Add key商品コード, Arr各行
            
        End If
        
    Next
    
    ' 実行テスト
    MsgBox Dic商品リスト(101)(2) & "の価格は" & Dic商品リスト(101)(4) & "円です。"
        ' 「みかんの価格は100円です。」が表示されます。
    
End Sub

このようにItemを一次元配列にすることで、
ひとつのDictionaryにすべてのデータを格納することが出来ます。

この方法は改修時にDictionaryの数を増減しなくて済むのがメリットですが、
中の配列を書き替えることが出来ないという仕様上の欠点があります。

Dic商品リスト(101)(2) = "愛媛みかん"
MsgBox Dic商品リスト(101)(2) ' ← 「みかん」が表示されます。

このコードの通り、みかんを愛媛みかんに書き替えることが出来ていません。

よってこの方法は基本的には読み取って吐き出すだけで、
途中の書き替えは行わない処理でのみ使用するコードとなります。

詳しくはこちらの記事をご覧ください。

この方法における「ひとつのDictionaryにすべてのデータを格納する」というのは、
そこまでメリットか？というとそうでもない気がします。

前述の「列数分だけDictionaryを用意」コードの方が使い勝手はいいため、
よほど大量の列でない限りはそのコードで十分ですからね。

このあたりは好みもあると思いますので、状況に応じて使い分けてください。

汎用関数化

この処理をよく行う方は、汎用関数にして持っておくのをおすすめします。

2つのセル範囲をKey/Itemそれぞれに格納

' Key/Item範囲 → Dictionary
Function Key範囲とItem範囲をDictionaryに変換(Key範囲 As Range, Item範囲 As Range) As Dictionary

    Dim Dic結果 As New Dictionary

    Dim i As Long
    For i = 1 To Key範囲.Cells.Count
        If Dic結果.Exists(Key範囲.Cells(i).Value) = False Then
            Dic結果.Add Key範囲.Cells(i).Value, Item範囲.Cells(i).Value
        End If
    Next
    
    Set Key範囲とItem範囲をDictionaryに変換 = Dic結果

End Function

　
▼ 使用例
2列のデータ

Sub セル範囲をDictionaryに格納する()
    
    Dim 最終行 As Long: 最終行 = WSマスタ.UsedRange.Rows.Count
    Dim Dic商品リスト As New Dictionary
    Set Dic商品リスト = Key範囲とItem範囲をDictionaryに変換( _
        WSマスタ.Range("A2:A" & 最終行), WSマスタ.Range("B2:B" & 最終行))
    
    ' 実行テスト
    MsgBox Dic商品リスト(101) ' ←みかんが表示されます。
    
End Sub

テーブル形式の表データをDictionaryに格納

' データ全体 → 配列 In Dictionary
Function データ全体をItemを配列とするDictionaryに変換(データ範囲 As Range, C_Key列 As Long) As Dictionary
    
    Dim Dic結果 As New Dictionary
    
    ' 読取も配列にして高速化
    Dim Arrデータ範囲: Arrデータ範囲 = データ範囲.Value
    
    Dim C1st As Long: C1st = データ範囲.Column
    Dim CLast As Long: CLast = データ範囲.Columns.Count + C1st - 1
    
    ' データの全行をループ
    Dim i As Long
    For i = 1 To データ範囲.Rows.Count
        
        ' 新規Keyの行を配列化してDictionaryに格納
        Dim key: key = Arrデータ範囲(i, C_Key列 - C1st + 1)
        If Dic結果.Exists(key) = False Then
    
            ' 配列の添字は列番号と一致させる
            Dim Arrデータ各行()
            ReDim Arrデータ各行(C1st To CLast)
            
            Dim C As Long
            For C = C1st To CLast
                Arrデータ各行(C) = Arrデータ範囲(i, C - C1st + 1)
            Next
            
            Dic結果.Add key, Arrデータ各行
    
        End If
    
    Next
    
    Set データ全体をItemを配列とするDictionaryに変換 = Dic結果
    
End Function

　
▼ 使用例
テーブル形式データ

Sub テーブル形式データをDictionaryに格納する()
    
    Dim 最終行 As Long: 最終行 = WSマスタ.UsedRange.Rows.Count
    Dim Dic商品リスト As New Dictionary
    Set Dic商品リスト = データ全体をItemを配列とするDictionaryに変換( _
        WSマスタ.Range("A2:D" & 最終行), 1)

    ' 実行テスト
    MsgBox Dic商品リスト(101)(2) & "の価格は" & Dic商品リスト(101)(4) & "円です。"
        ' 「みかんの価格は100円です。」が表示されます。