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

前回、Excelシートのデータ構造のままVBA上で扱う例 を示しました。
ここでは、次にこのデータを部署ごとに振り分ける方法を記載します。

参照設定を行う(出来れば)

Dictionaryを使用する場合、ツール→参照設定にて、”Microsoft Scripting Runtime” にチェックを入れておいた方が良いでしょう。
Dictionaryオブジェクトのインテリセンス機能が使用できるからです。
何らかの理由により参照設定が出来ない場合のパターンも記載していきます。

部署名をキーとしたDictionaryを返すプロシージャ

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

EmployeeClass.cls

Public Id As String             ' ID
Public Name As String           ' 名前
Public Department  As String    ' 部署

参照設定できたパターン

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

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

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) のアドレスを参照しているためですが、直観的には分かりにくいかもしれません。
その場合は、下記の方が読み解きやすいでしょう。どちらでも同じ結果になるのでお好みでどうぞ。

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()は前回作成したプロシージャになります。

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が入っていることが分かります。

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

参考文献

Dictionaryオブジェクトを利用する参照設定
VBAでCollectionとdictionaryを使う
VBAで連想配列 ～ Scripting.Dictionary