VBAでのDictionaryを使ってデータを振り分け方法

前回、[Excelシートのデータ構造のままVBA上で扱う例](https://qiita.com/saeki4n/items/12f3ccbafbbd50bba616) を示しました。
ここでは、次にこのデータを部署ごとに振り分ける方法を記載します。

# 参照設定を行う(出来れば)
Dictionaryを使用する場合、ツール→参照設定にて、”Microsoft Scripting Runtime” にチェックを入れておいた方が良いでしょう。
Dictionaryオブジェクトのインテリセンス機能が使用できるからです。
何らかの理由により参照設定が出来ない場合のパターンも記載していきます。
![参照設定.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/430322/25cf6e58-a6f0-5aff-0ba5-690853425154.png)

# 部署名をキーとしたDictionaryを返すプロシージャ
ここで 従業員の一覧データを引数として、それを元に部署名をキーとしたDictionaryを返すプロシージャを作成します。
上記での参照設定が出来ない場合の対策として、「参照設定できたパターン」と「参照設定できないパターン」をそれぞれ示しておきます。


```vb:EmployeeClass.cls
Public Id As String             ' ID
Public Name As String           ' 名前
Public Department  As String    ' 部署
```

参照設定できたパターン

```vb:EmployeeModule.bas

' 部署名をキーとしたDictionaryデータを作成する
' 引数:EmployeeClassのCollection
' 参照設定できた場合
Function CreateDepartmentDictionary(ByVal employeeList As Collection) As Dictionary
    Dim employeeData As EmployeeClass
    Dim list As Collection
    Dim dic As Dictionary                               ' 参照設定できた場合
    Set dic = New Dictionary                            ' 参照設定できた場合
    
    For Each employeeData In employeeList
        '部署ごとで振り分ける
        If dic.Exists(employeeData.Department) Then
            Set list = dic(employeeData.Department)  ' 既に存在した場合は、Dictionaryから中身を取り出す
        Else
            Set list = New Collection   ' キーが存在しない場合は初期化する
            Set dic(employeeData.Department) = list ' 部署名をキーとして初期化した内容をDictionaryにセットする
        End If
        list.Add employeeData   ' 値を追加する
        DoEvents
    Next
    Set CreateDepartmentDictionary = dic
End Function

```

参照設定できないパターン

```vb:EmployeeModule.bas

' 部署名をキーとしたDictionaryデータを作成する
' 引数:EmployeeClassのCollection
' 参照設定できない場合
Function CreateDepartmentDictionary(ByVal employeeList As Collection) As Object
    Dim employeeData As EmployeeClass
    Dim list As Collection
    Dim dic As Object                                  ' 参照設定できない場合
    Set dic = CreateObject("Scripting.Dictionary")     ' 参照設定できない場合
    
    For Each employeeData In employeeList
        '部署ごとで振り分ける
        If dic.Exists(employeeData.Department) Then
            Set list = dic(employeeData.Department)  ' 既に存在した場合は、Dictionaryから中身を取り出す
        Else
            Set list = New Collection   ' キーが存在しない場合は初期化する
            Set dic(employeeData.Department) = list ' 部署名をキーとして初期化した内容をDictionaryにセットする
        End If
        list.Add employeeData   ' 値を追加する
        DoEvents
    Next
    Set CreateDepartmentDictionary = dic
End Function

```

※ list.Add employeeData にするだけで、dic(employeeData.Department) の中身が更新されるのは list が dic(employeeData.Department) のアドレスを参照しているためですが、直観的には分かりにくいかもしれません。
その場合は、下記の方が読み解きやすいでしょう。どちらでも同じ結果になるのでお好みでどうぞ。

```vb:CreateDepartmentDictionary2
    For Each employeeData In employeeList
        '部署ごとで振り分ける
        If dic.Exists(employeeData.Department) Then
            Set list = dic(employeeData.Department)  ' キー既に存在した場合は、Dictionaryから中身を取り出す
        Else
            Set list = New Collection   ' キーが存在しない場合は初期化する
        End If
        list.Add employeeData   ' 値を追加する
        Set dic(employeeData.Department) = list  ' 部署名をキーとして中身をDictionaryにセットする
        DoEvents
    Next
```


# 実行例
適当なモジュールから CreateDepartmentDictionary() を呼び出して、中身を見ていきます。
GetAllEmployeeData()は[前回作成したプロシージャ](https://qiita.com/saeki4n/items/12f3ccbafbbd50bba616)になります。

```vb:Module1.bas
Sub StartDictionaryTest()
    Dim employeeList As Collection
    Dim employeeData As EmployeeClass
    Set employeeList = GetAllEmployeeData   ' 従業員データを呼び出す
        
    Dim dic As Dictionary
    Set dic = CreateDepartmentDictionary(employeeList) ' 部署ごとのDictionaryを作成する
    
    Dim salesList As Collection
    Set salesList = dic("営業部")
    Debug.Print "営業部の人数は" & salesList.Count & "人です。"
    For Each employeeData In salesList
        Debug.Print "・" & employeeData.Name & "(" & employeeData.Id & ")さん"
    Next
    
    Dim devList As Collection
    Set devList = dic("開発部")
    Debug.Print "開発部の人数は" & devList.Count & "人です。"
    For Each employeeData In devList
        Debug.Print "・" & employeeData.Name & "(" & employeeData.Id & ")さん"
    Next
    
    Dim geneList As Collection
    Set geneList = dic("総務部")
    Debug.Print "総務部の人数は" & geneList.Count & "人です。"
    For Each employeeData In geneList
        Debug.Print "・" & employeeData.Name & "(" & employeeData.Id & ")さん"
    Next
End Sub
```

# 実行結果
上記 StartDictionaryTest() を実行した結果です。Dictionaryの中に 部署ごとに振り分けられたEmployeeClassのCollectionが入っていることが分かります。
![実行例2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/430322/791ed881-8079-ca85-b210-27208b7a0e6e.png)

以上が、Dictionaryを使ってデータを振り分ける方法になります。

# 参考文献
[Dictionaryオブジェクトを利用する参照設定](https://www.relief.jp/docs/vba-refer-for-dictionary-object.html)
[VBAでCollectionとdictionaryを使う](https://qiita.com/pregum/items/071f72969d72d90cf826)
[VBAで連想配列 ～ Scripting.Dictionary](http://www.niji.or.jp/home/toru/notes/17.html)