【Excel VBA 再利用コード集】ネストした辞書（Dictionary in Dictionary）を作成する

Option Explicit


Public Sub DebugPrintShiftWariateDic()

    ' シフト→可スタッフ辞書を作成（辞書が取得できなかった場合は終了）
    Dim staff_shift_kahi_dic As Scripting.Dictionary
    Set staff_shift_kahi_dic = CreateShiftWariateDic()
    If staff_shift_kahi_dic Is Nothing Then Exit Sub

    ' 辞書の中身を確認（Debug.Print）
    '--------------------------------------------------------------------------
    ' すべてのシフト名（外側辞書のkey）を走査
    Dim shift_name As Variant
    For Each shift_name In staff_shift_kahi_dic.Keys

        Debug.Print shift_name
        
        ' 対象シフト名の中の全スタッフ名（内側辞書のkey）を走査
        Dim staff_name As Variant
        For Each staff_name In staff_shift_kahi_dic(shift_name).Keys
            ' スタッフ名を出力
            Debug.Print "  "; staff_name
        Next staff_name
    
    Next shift_name

End Sub


Public Function CreateShiftWariateDic() As Scripting.Dictionary

    ' Description
    '   シフト割当表シートを参照し、シフト名→可（〇）スタッフ辞書を作成して返す。
    '   外側辞書：Key=シフト名、value=内側辞書（可スタッフ辞書）
    '
    ' Arguments
    '   (None)
    '
    ' Returns
    '   Dictionary
    '     key   : shift_name (String)
    '     value : Dictionary
    '               key   : staff_name (String)
    '               value : True (Boolean)
    '
    ' References
    '   Microsoft Scripting Runtime


    ' シートの取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("シフト割当表")
    
    ' シートの対象範囲を配列として取得
    Dim staff_shift_kahi_tbl As Variant    ' 配列
    staff_shift_kahi_tbl = ws.UsedRange.Value

    ' 固定仕様（シフト割当表）
    Const STAFF_NAME_COL      As Long = 1   ' 氏名列
    Const SHIFT_START_COL     As Long = 2   ' シフト開始列（B列）
    Const HEADER_ROW          As Long = 1   ' ヘッダ行
    Const DATA_START_ROW      As Long = 2   ' データ開始行

    ' ガード（空配列）
    If IsEmpty(staff_shift_kahi_tbl) Then
        Set CreateShiftWariateDic = Nothing
        Exit Function
    End If

    ' 外側辞書：シフト名 → 可スタッフ辞書 の対応を保持する辞書
    Dim staff_shift_kahi_dic As Scripting.Dictionary
    Set staff_shift_kahi_dic = New Scripting.Dictionary
    
    ' 外側辞書に内側辞書を登録
    '--------------------------------------------------------------------------
    ' 配列を列方向に走査
    Dim shift_col As Long
    For shift_col = SHIFT_START_COL To UBound(staff_shift_kahi_tbl, 2)

        ' シフト名を取得（空欄はスキップ）
        Dim shift_name As String
        shift_name = Trim$(CStr(staff_shift_kahi_tbl(HEADER_ROW, shift_col)))
        If Len(shift_name) = 0 Then GoTo NextShiftCol


        ' 外側辞書に「シフト名」が未登録の場合
        If Not staff_shift_kahi_dic.Exists(shift_name) Then

            ' 内側辞書（可スタッフ辞書）を新規作成
            Dim assignable_staff_dic As Scripting.Dictionary
            Set assignable_staff_dic = New Scripting.Dictionary

            ' 「シフト名」をキー、「可スタッフ辞書」をバリューとして外側辞書に登録
            staff_shift_kahi_dic.Add shift_name, assignable_staff_dic

        End If

        ' 内側辞書にスタッフを登録
        '----------------------------------------------------------------------
        ' 配列を行方向を走査
        Dim staff_row As Long
        For staff_row = DATA_START_ROW To UBound(staff_shift_kahi_tbl, 1)

            ' スタッフ名を取得（空欄は対象外）
            Dim staff_name As String
            staff_name = Trim$(CStr(staff_shift_kahi_tbl(staff_row, STAFF_NAME_COL)))
            If Len(staff_name) = 0 Then GoTo NextStaffRow

            ' クロスポイントの値を取得（○がなければ対象外）
            Dim cell_val As String
            cell_val = Trim$(CStr(staff_shift_kahi_tbl(staff_row, shift_col)))
            If InStr(1, cell_val, "○", vbTextCompare) = 0 Then GoTo NextStaffRow

            ' 内側辞書に未登録の場合、スタッフ名を追加
            If Not staff_shift_kahi_dic(shift_name).Exists(staff_name) Then
                staff_shift_kahi_dic(shift_name).Add staff_name, True
            End If

NextStaffRow:
        Next staff_row

NextShiftCol:
    Next shift_col
    
    ' シフト割当表辞書を返す
    Set CreateShiftWariateDic = staff_shift_kahi_dic

End Function