テーブルのラベルを指定して辞書を作成 - Infomentのブログ～Excel VBA奮闘記～

例えば以下のような表で、品名と価格を連想配列（以降「辞書」）化したい
場合があります。

f:id:Infoment:20180716081738p:plain

この辞書では、「りんご」というキーを与えると、「100」というアイテムを返します。
この「辞書を作成する処理」は、個人的に結構な頻度で多用しています。そこで、毎回
コードを作成するのが面倒だったので、関数化してみました。

'============================================================
' Name     : CreateDict
' Input    :
'   Tb As ListObject    辞書用テーブル
'   keyIndex As Variant キー列のラベル
'   itmIndex As Variant アイテム列のラベル
' Output   : 指定列で作成した辞書
' Purpose  : 辞書データ作成の簡素化
' Remarks  : https://infoment.hatenablog.com/entry/2018/07/16/085459
' Author   : infoment
' Start    : 2018/7/16
' Version  : 1.1
'============================================================
Function CreateDict(Tb As ListObject, keyIndex As Variant, _
                    itmIndex As Variant) As Dictionary
    
    Dim Dict    As Dictionary  ' Microsoft Scripting Runtime 参照設定済み
    Dim keySeq  As Variant     ' 配列：キー格納用
    Dim itmSeq  As Variant     ' 配列：アイテム格納用
    Dim i       As Long        ' ループカウンタ
    
    ' 辞書の初期化。
    Set Dict = New Dictionary
    ' 各データを配列に格納。
    keySeq = Tb.ListColumns(keyIndex).DataBodyRange
    itmSeq = Tb.ListColumns(itmIndex).DataBodyRange
    ' 各値を辞書にセット。
    For i = LBound(keySeq) To UBound(keySeq)
        Dict(keySeq(i, 1)) = itmSeq(i, 1)
    Next
    ' 関数に辞書をセット。
    Set CreateDict = Dict

End Function

テーブルの各行各列をキーとアイテムで各々指定してもよかったのですが、行列の指定が煩雑だったので、一旦配列に格納して処理しています。

この関数を用いたサンプルが、こちらになります。

Sub test()
    Dim Dict As Dictionary
    Dim Tb   As ListObject
    
    Set Tb = ActiveSheet.ListObjects(1)
    Set Dict = CreateDict(Tb, "品名", "単価")
    
    MsgBox Dict("ばなな")
End Sub