VBAでの辞書型変数の使い方と活用方法

え、VBA！？

まあそう言わないでください。
なんやかんや便利じゃないですか。
社内の方がアドベントカレンダーに参加するハードルを下げたいという思惑もあります。

環境

Windows 10
Excel 2016
Microsoft Scripting Runtimeがオン (方法は後述します)

辞書型ってなに？

辞書型変数の前に配列のお話し

配列は値の出し入れに添え字を使います。

Sub array_test()

    Dim arr() As Variant
    ReDim Preserve arr(1, 0)
    
    'arr(0, x) には名前を代入
    'arr(1, x) には年齢を代入
    
    arr(0, 0) = "Taro"
    arr(1, 0) = 40
        
    ReDim Preserve arr(1, 1)
    arr(0, 1) = "Hanako"
    arr(1, 1) = 35

    Debug.Print arr(0, 0) 'Taro
    Debug.Print arr(1, 0) '40
    Debug.Print arr(0, 1) 'Hanako
    Debug.Print arr(1, 1) '35    
    
End Sub

コードを書いた人は各次元の0番目には名前、1番目には年齢、というように頭の中にイメージができあがってるかもしれません。
しかし、要素数が増えていけば「あの要素って何番目だっけ？」ってなることは必至でしょう。
ましてや、メンテナンスする人にとっては解読が大変です。
コメントにルールを書いても、それでもやっぱり辛いです。

あと、もう一つ最大の弱点として、動的には最終次元しか増やすことができないという問題があります（これは配列の弱点というより、VBAの弱点ですが）。
この例でいうと、1次元目に"趣味"のような要素を後で増やすことができないです。
かといって、この例では人数がどんどん増えていきそうなので、最終次元で人数を増やしていきたいです。
というように、設計で不自由を感じることがあります。

そこで辞書型！

余り知られていない気がしてますが、VBAでも辞書型変数を作成できます。
collection型でもできますが、必ずkey - value が入るのであればdictionary型の方が使いやすいです。

VBAでdictionary型を使うための設定

dictionary型の良さをフルで享受しようと思ったら、VBAのエディタから
ツール -> 参照設定 -> Microsoft Scripting Runtime にチェック -> OK
が必要です。

上述の配列の例を辞書で扱ってみる

細かいところは後ほど解説します。
まずは雰囲気だけでもつかめれば。

Sub dictionary_test()

    Dim arr() As Variant
    
    ReDim Preserve arr(0)

    ' 配列の1要素をdictionaryにしてしまう
    Set arr(0) = New Dictionary
    
    'こんな感じでkey - valueを追加していく
    arr(0).Add "name", "Taro"
    arr(0).Add "age", 40
    
    ReDim Preserve arr(1)
    Set arr(1) = New Dictionary
    
    arr(1).Add "name", "Hanako"
    arr(1).Add "age", 35

    'こんな感じでkeyから呼び出せる
    Debug.Print arr(0)("name") 'Taro
    Debug.Print arr(0)("age") '40
    Debug.Print arr(1)("name") 'Hanako
    Debug.Print arr(1)("age") '35
    
    '後から要素を増やしたくなってもOK    
    arr(0).Add "hobby", "soccer"
    arr(1).Add "hobby", "traveling"
    
    Debug.Print arr(0)("hobby") 'soccer
    Debug.Print arr(1)("hobby") 'traveling
    
End Sub

辞書型変数の使い方

では細かく辞書型の使い方を見ていきましょう

Sub dictionary_usage()

    'Dictionary型の宣言方法
    Dim myDict As New Dictionary
    
    'こんな感じでkey - valueを追加していく
    myDict.Add "name", "Taro"
    myDict.Add "age", 40

    Debug.Print myDict("name") 'Taro
    Debug.Print myDict("age") '40
    
    'keyも取り出せる
    Debug.Print myDict.Keys(0) 'name
    Debug.Print myDict(myDict.Keys(0)) 'Taro
    
    'もちろんfor eachも使える
    Dim v As Variant
    For Each v In myDict.Keys
        Debug.Print v & ": "; myDict(v)
    Next v
    
    'keyには数字も使えるし
    myDict.Add 5, "five"
    Debug.Print myDict(5) 'five

    '配列以外なんでもkeyに使えるとのこと(使ったことないけど)
    myDict.Add Worksheets("Sheet1"), Worksheets("Sheet1").name
    Debug.Print myDict(Worksheets("Sheet1")) 'Sheet1
    
    
    'Keyの存在確認
    
    Debug.Print myDict.Exists("name") 'True
    
    '要素数の確認
    Debug.Print myDict.Count '4
    
    '削除はこんな感じ
    myDict.Remove ("name")
        
    Debug.Print myDict.Exists("name") 'False
    Debug.Print myDict.Count '2
          
    '全消しもできちゃう
    myDict.RemoveAll
    Debug.Print myDict.Count '0
    
    
    '存在しないkeyを指定した場合、errorになるわけではなく、指定したキーと空のvalueでitemが増える
    '当初存在しない"hobby"というkeyで実験
    Debug.Print myDict.Exists("hobby") 'false
    Debug.Print myDict("hobby") '指定したキーと空のvalueの組み合わせができる
    Debug.Print myDict.Exists("hobby") 'True
    Debug.Print TypeName(myDict("hobby")) 'Empty
    
    '指定したkeyに後からvalueを入れることも可能
    myDict("hobby") = "soccer"
    Debug.Print myDict("hobby") 'soccer
    
    'つまり、上書きも可能
    myDict("hobby") = "tennis"
    Debug.Print myDict("hobby") 'tennis
    
    '.addの方はあくまでもkeyとvalueをセットでの代入
    'そして、重複するkeyを追加しようとするとerrorになる（上書きにはならない）
    
    myDict.Add "name", "Hanako"
    myDict.Add "name", "Jiro" 'このキーは既にこのコレクションの要素に割り当てられています (エラー 457)

End Sub

どんな使い方が便利？

私が最初に使ったきっかけは、表のHeader行の辞書化でした。
例えばこんな表があったとして

列番号をハードコードしている、メンテ性の悪い関数があったとします。


' メンテが大変な関数
Function get_name_from_dept(dept_name As String) As Variant()
    
    With Worksheets("employee_list")
                
        Dim i As Long
        Dim last_row As Long
        Dim name_list()
        Dim cnt As Long
        
        last_row = .Cells(Rows.Count, 1).End(xlUp).Row
        cnt = 0
        
        For i = 1 To last_row
            If .Cells(i, 5) = dept_name Then '列番号をハードコードしてしまってる
                ReDim Preserve name_list(cnt)
                name_list(cnt) = .Cells(i, 2) & " " & .Cells(i, 3) '列番号をハードコードしてしまってる
                cnt = cnt + 1
            End If
        Next i
    End With
    
    get_name_from_dept = name_list

End Function

' 関数を呼ぶ側
Sub call_get_name_from_dept()

    Dim v As Variant
    
    For Each v In get_name_from_dept("sales")
        Debug.Print v
    Next v

'sato taro
'sato kouji

End Sub

こんな状況で途中に列が追加されると、発狂してしまいますよね。

発狂しないために、列名を辞書型で扱ってみます。


' メンテが楽になった関数
Function get_name_from_dept(dept_name As String) As Variant()
    
    With Worksheets("employee_list")                
                
        Dim last_col As Long
    
        last_col = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        Dim i As Long
        Dim dict_header As New Dictionary
        
        For i = 1 To last_col
            dict_header.Add .Cells(1, i).Value, i 'ここでheader行をdictにしてしまう
        Next
        
        'ここでheaderの辞書は完成しています。
        '例えば、dict_header("family_name")は 3を返すので、
        '.cells(3, dict_header("family_name")) はyamadaを返してくれます。

        Dim j As Long
        Dim last_row As Long
        Dim name_list()
        Dim cnt As Long
        
        last_row = .Cells(Rows.Count, 1).End(xlUp).Row
        cnt = 0
        
        For j = 1 To last_row
            If .Cells(j, dict_header("dept")) = dept_name Then 'keyで列番号を取得できるから、列を追加されても発狂せずに済む
                ReDim Preserve name_list(cnt)
                name_list(cnt) = .Cells(j, dict_header("family_name")) & " " & .Cells(j, dict_header("first_name"))
                cnt = cnt + 1
            End If
        Next j
    End With
    
    get_name_from_dept = name_list

End Function

辞書を配列に入れてやれば、色々と夢も広がります。

検索ワードと列名を指定すれば、該当する行を辞書として引っ張ってくる関数を作ってみました。
DB使いなさいと言われちゃいそうですが、そうもいかない現場もきっとあるでしょう。


' 検索ワード(search_word)と列名(search_key)を指定してやれば、該当するレコードを辞書として引っ張ってくる関数
Function get_info_from_key(search_word As Variant, search_key As String) As Variant()
   
    With Worksheets("employee_list")
        
        Dim last_col As Long
    
        last_col = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        Dim r As Range
        Dim dict_header As New Dictionary
        
        ' まずはheader行で列名と列番号の辞書を作成
        For Each r In .Range(.Cells(1, 1), .Cells(1, last_col))
            dict_header.Add r.Value, r.Column
        Next
        
        ' 引数に指定されたkeyが列名に存在しない場合は終了
        If Not dict_header.Exists(search_key) Then
            MsgBox ("該当するsearch_keyがありませんでした。")
            End
        End If
        
        Dim last_row As Long
        last_row = .Cells(Rows.Count, 1).End(xlUp).Row
        Dim j As Long
        Dim key As Variant
        Dim target_counter As Long
        target_counter = 0
        Dim intermediate() As Variant
        
        ' 2行目から最終行まで、search_keyで指定された列にsearch_wordがないかをなめる
        For j = 2 To last_row
            If .Cells(j, dict_header(search_key)) = search_word Then
                ' hitしたらReDimして辞書を生成
                ReDim Preserve intermediate(target_counter)
                Set intermediate(target_counter) = New Dictionary
                
                ' dict_headerのkeyをkey、該当列の値をvalueとした辞書を作成
                For Each key In dict_header
                    intermediate(target_counter).Add key, .Cells(j, dict_header(key)).Value
                Next key
                target_counter = target_counter + 1
            End If
        Next j
    End With
        
    ' search_wordでhitする行が0だったらintermediate(0)にnullを入れて返す
    If target_counter = 0 Then
        ReDim Preserve intermediate(0)
        intermediate(0) = Null
    End If
    get_info_from_key = intermediate
        
End Function

Sub get_age_from_family_name()

    Dim dict_array As Variant

    '例えば姓で検索して名前と年齢も引っ張る、なんて使い方

    dict_array = get_info_from_key("sato", "family_name")
    Dim v As Variant
    If TypeName(dict_array(0)) = "Dictionary" Then
        For Each v In dict_array
            Debug.Print Join(Array(v("family_name"), v("first_name"), "is", v("age"), "years old"), " ")
        Next v
    End If        

'sato taro is 50 years old
'sato kouji is 36 years old
        
End Sub

と、こんな感じで使い勝手がよい関数も作れます。

おわりに

VBAでも意外と辞書型が使えること、そして表データととても相性がいいことがお分かりいただけたのではないでしょうか。
再帰処理もさせればQueryみたいなこともできるのではないか、など夢はどんどん広がりますが、それならいよいよDBの導入を検討した方が良いですね。

参考

Microsoftのdictionaryのリファレンス