辞書(連想配列)に複数のアイテムを登録できた感じにする

f:id:Infoment:20190202143923p:plain
職場の勉強会で、こんな質問を受けた。

辞書(連想配列)って、(一つのキーにアイテムは)一個しか
登録できないんですか?

「そうだよ」と答えた後に、ふと思った。それで、試してみた。

Sub DictTest()
    Dim Dict As Dictionary
    Set Dict = New Dictionary
        Dict("桃太郎") = Array("犬", "猿", "雉")
        
        MsgBox Dict("桃太郎")(1)
End Sub

結果は、以下の通り。1番目の「猿」を表示させることが出来た。
(※犬は0番目)。
f:id:Infoment:20190202142454p:plain

今まで考えたことも無かったが、辞書のitemには配列も登録できるようだ。知らなかったのは、私だけか?そこで、なんちゃって個人情報を拝借し、こんなものを作ってみた。
f:id:Infoment:20190202142652p:plain

まず、ラベル情報で列挙型を設定する。

Enum 列
    名前 = 1
    ふりがな
    アドレス
    性別
    年齢
    誕生日
    婚姻
    都道府県
    携帯
    キャリア
    カレーの食べ方
End Enum

次いで、個人情報の範囲を引数として受け取り、辞書を作成するユーザー定義関数を準備した。

Function GetListDict(list_range As Range) As Dictionary
    Dim Dict As Dictionary
    Set Dict = New Dictionary
    
    ' なんちゃって個人情報を、一旦配列に格納する。
    Dim ListSeq As Variant
        ListSeq = list_range
    
    ' ループカウンタ:行
    Dim r As Long
    ' ループカウンタ:列
    Dim c As Long
    ' 表の各行を格納するための配列
    Dim ListRowSeq() As Variant
    ReDim ListRowSeq(2 To UBound(ListSeq, 2))
    
    ' 各行を配列化し、各「名前」をキーとして辞書に登録する。
    For r = 2 To UBound(ListSeq, 1)
        For c = 2 To UBound(ListSeq, 2)
            ListRowSeq(c) = ListSeq(r, c)
        Next
        Dict(ListSeq(r, 1)) = ListRowSeq
    Next
    
    Set GetListDict = Dict
End Function

テストしてみた。

Sub DictTest()
    Dim Dict As Dictionary
    Set Dict = GetListDict(Range("A1").CurrentRegion)
    
        MsgBox Dict("赤羽 里奈")(.カレーの食べ方)
End Sub

↓ 「赤羽 里奈」さんのカレーの食べ方を、正しく取得することが出来たようだ。
f:id:Infoment:20190202143433p:plain
f:id:Infoment:20190202143210p:plain

しかしこれだと、挙動としては何だかVLOOKUPとあまり変わらない。もし使い処があるとすれば、

  1. 別のシートから値だけ取ってきたい。
  2. キーとなる情報が、表の一番左に無い。

などの場合だろうか。

いつか使うときが来るかもしれないので、備忘録としてここに残しておきます。

参考まで。