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の導入を検討した方が良いですね。