【AI × Excel VBA】勤務シフト表で週と月の労働時間を考慮する方法（配列＋辞書利用）【再利用コード集】

[ Dom_CreateCalendar ]
└─ AddShukujisuToTanmuWs（担務表ヘッダに祝日情報を反映して書き戻す）
　 ├─ GetShukujitsuTbl（祝日シートを配列で取得　※同一モジュール内）
　 │　└─ [ Util_GetArray ]
　 │　　 ├─ GetUsedRangeArray（使用範囲を配列で取得）
　 │　　 └─ DebugPrintArraySize（配列サイズをデバッグ出力）
　 │
　 └─ AddShukujitsuToTanmuHeaderTbl（担務表ヘッダ配列へ祝日名を反映　※同一モジュール内）

└─ GetTaishoKikan（基準月の対象期間列を取得　※同一モジュール内）

[ Dom_CreateTanmuWs ]
└─ CreateTanmuWs（曜日条件に合うセルのみ担当者を割当＋略称を表示）
　 ├─ [ Util_GetArray ]
　 │　├─ GetUsedRangeArray（使用範囲を配列で取得）
　 │　└─ DebugPrintArraySize（配列サイズをデバッグ出力）
　 │
　 ├─ [ Dom_CreateDic ]
　 │　├─ CreateShiftWariateDic（シフト→可スタッフ辞書）
　 │　├─ CreateYoubiJoukenDic（シフト→曜日条件辞書）
　 │　├─ CreateTanmuJikanDic（シフト→勤務時間辞書）
　 │　├─ CreateStaffShuKinmuJikanDic（スタッフ×週→勤務時間合計）
　 │　└─ GetWeekStartDateFromDate（日付→週開始日を返す）
　 │
　 ├─ [ Dom_CreateCalendar ]
　 │　└─ GetTaishoKikan（対象期間列を取得）
　 │
　 ├─ GetYoubiKeyFromTanmuHeader（祝日優先で「祝」/曜日を返す　※同一モジュール内）
　 │
　 ├─ [ Util_ShuffleElements ]
　 │　└─ ShuffleArrayByFisherYates（候補者シャッフル）
　 │
　 └─ [ Pres_WorkTimeSummary ]
　　　└─ WriteWeekWorkTimeSummaryToTanmuWs（週合計勤務時間を出力）

[ Pres_WorkTimeSummary ]
└─ WriteWeekWorkTimeSummaryToTanmuWs（週合計勤務時間を担務表下部へ出力）
　 ├─ [ Util_GetArray ]
　 │　└─ GetUsedRangeArray（使用範囲を配列で取得）
　 │
　 ├─ [ Dom_CreateCalendar ]
　 │　└─ GetTaishoKikan（対象期間列を取得）
　 │
　 ├─ [ Dom_CreateDic ]
　 │　├─ CreateTanmuJikanDic（シフト→勤務時間辞書）
　 │　└─ CreateStaffShuKinmuJikanDic（スタッフ×週→勤務時間合計）
　 │
　 └─ GetRyakushoList（スタッフ略称一覧を取得　※同一モジュール内）

└─ WriteMonthWorkTimeSummaryToTanmuWs（月合計勤務時間を担務表下部へ出力）
　 ├─ [ Util_GetArray ]
　 │　└─ GetUsedRangeArray（使用範囲を配列で取得）
　 │
　 ├─ [ Dom_CreateDic ]
　 │　├─ CreateTanmuJikanDic（シフト→勤務時間辞書）
　 │　└─ CreateStaffMonthKinmuJikanDic（スタッフ→月合計勤務時間）
　 │
　 └─ GetRyakushoList（スタッフ略称一覧を取得　※同一モジュール内）

Option Explicit


Public Sub AddShukujisuToTanmuWs()

    ' Description
    '   担務表ヘッダ配列に祝日情報を反映し、シートへ書き戻す。
    '
    ' Arguments
    '   (none)
    '
    ' Returns
    '   (none)
    '
    ' Dependency Tree
    '   AddShukujisuToTanmuWs
    '     ├─ GetShukujitsuTbl
    '     │   └─ GetUsedRangeArray
    '     └─ AddShukujitsuToTanmuHeaderTbl


    ' 担務表シート取得
    Dim tanmu_ws As Worksheet
    Set tanmu_ws = ThisWorkbook.Worksheets("担務表")

    ' 担務表ヘッダー配列取得
    Dim tanmu_header_tbl As Variant
    tanmu_header_tbl = tanmu_ws.Range("A1:AL4").Value
    
    ' 祝日配列取得
    Dim shukujitsu_tbl As Variant
    shukujitsu_tbl = GetShukujitsuTbl()

    ' ガード（祝日配列が取得できない場合）
    If IsEmpty(shukujitsu_tbl) Then
        MsgBox "shukujitsu_tbl が取得できません。", vbExclamation
        Exit Sub
    End If

    ' 祝日反映（配列更新）
    Call AddShukujitsuToTanmuHeaderTbl(tanmu_header_tbl, shukujitsu_tbl)

    ' シートへ書き戻し
    tanmu_ws.Range( _
        tanmu_ws.Cells(1, 1), _
        tanmu_ws.Cells( _
            UBound(tanmu_header_tbl, 1), _
            UBound(tanmu_header_tbl, 2) _
        ) _
    ).Value2 = tanmu_header_tbl

End Sub

Private Function GetShukujitsuTbl() As Variant

    ' Description
    '   「祝日」シートの「A1:B最終行」までを、配列として取得する
    '
    ' Dependency Tree
    '   GetShukujitsuTbl
    '     ├─ GetUsedRangeArray
    '     └─ DebugPrintArraySize


    ' 祝日シートを取得
    Dim ws As Worksheet            ' 祝日シート
    Set ws = ThisWorkbook.Worksheets("祝日")

    ' 対象ワークシートの使用範囲を配列で取得(Util_GetArray 呼び出し)
    Dim shukujitsu_tbl As Variant     ' 祝日を格納する配列
    shukujitsu_tbl = GetUsedRangeArray(ws)
    Call DebugPrintArraySize(shukujitsu_tbl, "祝日シート配列")

    ' Return: 配列を返却
    GetShukujitsuTbl = shukujitsu_tbl

End Function

Private Sub AddShukujitsuToTanmuHeaderTbl( _
    ByRef tanmu_header_tbl As Variant, _
    ByVal shukujitsu_tbl As Variant _
)

    ' Description
    '   祝日配列（shukujitsu_tbl）に一致する日付が担務表ヘッダ配列（tanmu_header_tbl）の
    '   カレンダー範囲に存在した場合、該当列の祝日行セルを更新する。
    '
    ' Arguments
    '   tanmu_header_tbl : 担務表ヘッダを格納した2次元配列（更新対象）
    '   shukujitsu_tbl   : 祝日シートを格納した2次元配列（参照のみ）
    '
    ' Returns
    '   (none)
    '
    ' Dependency Tree
    '   (none)

    
    ' 固定仕様（担務表ヘッダ）
    Const DATE_ROW As Long = 1                ' 日付行（担務表ヘッダ内）
    Const SHUKUJITSU_ROW As Long = 3          ' 祝日書き込み行
    Const CALENDAR_START_COL As Long = 2      ' B
    Const CALENDAR_END_COL As Long = 32       ' AF

    ' 祝日配列の最終行を取得
    Dim shukujitsu_last_row As Long
    shukujitsu_last_row = UBound(shukujitsu_tbl, 1)

    ' 祝日配列を走査（2行目～最終行：1行目はヘッダ）
    Dim row As Long
    For row = 2 To shukujitsu_last_row
    
        ' 祝日日付を取得（空行・日付以外はスキップ）
        If Not IsDate(shukujitsu_tbl(row, 1)) Then GoTo ContinueShukujitsuRow
        Dim shukujitsu_date As Date
        shukujitsu_date = shukujitsu_tbl(row, 1)
    
        ' 祝日名を取得（空行はスキップ）
        Dim shukujitsu_name As String
        shukujitsu_name = CStr(shukujitsu_tbl(row, 2))
        If Len(shukujitsu_name) = 0 Then GoTo ContinueShukujitsuRow
    
        ' 担務表ヘッダの日付行を走査
        Dim col As Long
        For col = CALENDAR_START_COL To CALENDAR_END_COL
    
            ' 日付が一致した列に祝日名をセット
            If tanmu_header_tbl(DATE_ROW, col) = shukujitsu_date Then
                tanmu_header_tbl(SHUKUJITSU_ROW, col) = _
                    Left(shukujitsu_name, 2)
                Exit For
            End If
    
        Next col
    
ContinueShukujitsuRow:
    Next row

End Sub


Public Sub GetTaishoKikan( _
    ByVal tanmu_tbl As Variant, _
    ByRef start_col As Long, _
    ByRef end_col As Long _
)

    ' Description
    '   担務表ヘッダ（日付行）を参照し、
    '   基準月の「月初を含む週の日曜」列を start_col、
    '   基準月の「月末を含む週の土曜」列を end_col として返す。
    '
    ' Arguments
    '   tanmu_tbl  : 担務表シートを格納した配列
    '   start_col : 対象期間の開始列（返却）
    '   end_col   : 対象期間の終了列（返却）
    '
    ' Returns
    '   (none)
    '
    ' Dependency Tree
    '   (none)


    ' 固定仕様（担務表ヘッダ）
    Const DATE_ROW As Long = 1
    Const DATE_SEARCH_START_COL As Long = 2   ' B列（日付探索の開始）
    Const ASSIGN_START_COL As Long = 9        ' I列（基準月決定に使う）


    ' 初期化
    start_col = 0
    end_col = 0

    ' ガード（エラーメッセージは上位側で表示する）
    If IsEmpty(tanmu_tbl) Or (Not IsArray(tanmu_tbl)) Then
        Exit Sub
    End If

    ' 基準日（I列の日付）
    Dim base_date As Date
    base_date = CDate(tanmu_tbl(DATE_ROW, ASSIGN_START_COL))

    ' 基準月の月初・月末を算出
    Dim base_year As Long
    base_year = Year(base_date)

    Dim base_month As Long
    base_month = Month(base_date)

    Dim month_start As Date
    month_start = DateSerial(base_year, base_month, 1)

    Dim month_end As Date
    month_end = DateSerial(base_year, base_month + 1, 0)


    ' 対象期間（月初を含む週の日曜、月末を含む週の土曜）を算出
    Dim period_start As Date
    period_start = month_start - (Weekday(month_start, vbSunday) - 1)

    Dim period_end As Date
    period_end = month_end + (7 - Weekday(month_end, vbSunday))


    ' 日付行を走査し、対象期間の開始列・終了列を特定
    '   担務表（配列）の列方向を走査
    Dim date_col As Long
    For date_col = DATE_SEARCH_START_COL To UBound(tanmu_tbl, 2)
    
        ' 日付を取得
        Dim current_date As Date
        current_date = tanmu_tbl(DATE_ROW, date_col)
    
        ' 対象期間の開始日と一致する列を取得
        If start_col = 0 Then
            If current_date = period_start Then start_col = date_col
        End If
    
        ' 対象期間の終了日と一致する列を取得
        If end_col = 0 Then
            If current_date = period_end Then end_col = date_col
        End If
    
        ' 両方見つかったら探索終了
        If start_col <> 0 And end_col <> 0 Then Exit For
    
    Next date_col


    ' ガード（エラーメッセージは上位側で表示する）
    If start_col = 0 Or end_col = 0 Then
        Exit Sub
    End If

End Sub

Option Explicit


Public Function CreateShiftWariateDic() As Scripting.Dictionary

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


    ' シートの取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("シフト割当表")

    ' シートの対象範囲を配列として取得
    Dim staff_shift_kahi_tbl As Variant
    staff_shift_kahi_tbl = GetUsedRangeArray(ws)
    Call DebugPrintArraySize(staff_shift_kahi_tbl, "シフト割当表配列")

    ' 固定仕様（シフト割当表）
    Const staff_ryakusho_col  As Long = 2   ' 略称列（B列）
    Const SHIFT_START_COL     As Long = 3   ' シフト開始列（C列）
    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_ryakusho As String
            staff_ryakusho = Trim$(CStr(staff_shift_kahi_tbl(staff_row, staff_ryakusho_col)))
            If Len(staff_ryakusho) = 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_ryakusho) Then
                staff_shift_kahi_dic(shift_name).Add staff_ryakusho, True
            End If

NextStaffRow:
        Next staff_row

NextShiftCol:
    Next shift_col

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

End Function


Public Function CreateYoubiJoukenDic() As Scripting.Dictionary

    ' Description
    '   シフト曜日条件表シートを参照し、シフト名→曜日条件辞書を作成して返す。
    '   外側辞書：Key=シフト名、value=内側辞書（曜日条件辞書）
    '
    ' Arguments
    '   (None)
    '
    ' Returns
    '   Dictionary
    '     key   : shift_name (String)
    '     value : Dictionary
    '               key   : youbi_key (String)  "日","月","火","水","木","金","土","祝"
    '               value : True (Boolean)
    '
    ' Dependency Tree
    '   CreateYoubiJoukenDic
    '     ├─ GetUsedRangeArray
    '     └─ DebugPrintArraySize
    '
    ' References
    '   Microsoft Scripting Runtime


    ' シートの取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("シフト曜日条件表")

    ' シートの対象範囲を配列として取得
    Dim youbi_jouken_tbl As Variant
    youbi_jouken_tbl = GetUsedRangeArray(ws)
    Call DebugPrintArraySize(youbi_jouken_tbl, "シフト曜日条件表配列")

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


    ' 固定仕様（シフト曜日条件表）
    Const SHIFT_NAME_COL   As Long = 1   ' シフト名列
    Const YOU_BI_START_COL As Long = 2   ' 曜日開始列
    Const HEADER_ROW       As Long = 1   ' ヘッダ行
    Const data_start_row   As Long = 2   ' データ開始行（シフト行）

    ' 外側辞書：シフト名 → 曜日条件辞書 の対応を保持する辞書
    Dim youbi_jouken_dic As Scripting.Dictionary
    Set youbi_jouken_dic = New Scripting.Dictionary


    ' 行方向（シフト）を走査し、内側辞書を作成
    '--------------------------------------------------------------------------
    Dim shift_row As Long
    For shift_row = data_start_row To UBound(youbi_jouken_tbl, 1)

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

        ' 内側辞書（曜日条件辞書）を新規作成
        Dim youbi_dic As Scripting.Dictionary
        Set youbi_dic = New Scripting.Dictionary

        ' 列方向（曜日）を走査し、○の曜日のみ内側辞書に登録
        '----------------------------------------------------------------------
        Dim youbi_col As Long
        For youbi_col = YOU_BI_START_COL To UBound(youbi_jouken_tbl, 2)

            ' 曜日キーを取得（空欄はスキップ）
            Dim header_val As String
            header_val = Trim$(CStr(youbi_jouken_tbl(HEADER_ROW, youbi_col)))
            If Len(header_val) = 0 Then GoTo NextYoubiCol

            Dim youbi_key As String
            If header_val = "祝日" Then
                youbi_key = "祝"
            Else
                youbi_key = header_val
            End If

            ' クロスポイントの値を取得（○/〇がなければ対象外）
            Dim cell_val As String
            cell_val = Trim$(CStr(youbi_jouken_tbl(shift_row, youbi_col)))

            If InStr(1, cell_val, "○", vbTextCompare) = 0 _
                And InStr(1, cell_val, "〇", vbTextCompare) = 0 Then _
                GoTo NextYoubiCol

            ' 内側辞書に未登録の場合、曜日キーを追加
            If Not youbi_dic.Exists(youbi_key) Then
                youbi_dic.Add youbi_key, True
            End If

NextYoubiCol:
        Next youbi_col

        ' 外側辞書に登録（内側辞書）
        youbi_jouken_dic.Add shift_name, youbi_dic

NextShiftRow:
    Next shift_row


    ' Return
    Set CreateYoubiJoukenDic = youbi_jouken_dic

End Function


Public Function CreateTanmuJikanDic() As Scripting.Dictionary

    ' Description
    '   「勤務時間表」シートを参照し、
    '   シフト名（担務名）→勤務時間 の辞書を作成して返す。
    '
    ' Arguments
    '   (None)
    '
    ' Returns
    '   Dictionary
    '     key   : shift_name (String)
    '     value : work_hours (Double)
    '
    ' Dependency Tree
    '   CreateTanmuJikanDic
    '     ├─ GetUsedRangeArray
    '     └─ DebugPrintArraySize
    '
    ' References
    '   Microsoft Scripting Runtime


    ' シートの取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("勤務時間表")

    ' 使用範囲を配列で取得
    Dim work_time_tbl As Variant
    work_time_tbl = GetUsedRangeArray(ws)
    Call DebugPrintArraySize(work_time_tbl, "勤務時間表配列")

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

    ' 固定仕様（勤務時間表）
    Const SHIFT_NAME_COL As Long = 1
    Const WORK_HOURS_COL As Long = 2
    Const data_start_row As Long = 2

    ' 辞書を作成
    Dim tanmu_jikan_dic As Scripting.Dictionary
    Set tanmu_jikan_dic = New Scripting.Dictionary

    ' 行方向に走査して登録
    Dim row As Long
    For row = data_start_row To UBound(work_time_tbl, 1)

        Dim shift_name As String
        shift_name = Trim$(CStr(work_time_tbl(row, SHIFT_NAME_COL)))
        If Len(shift_name) = 0 Then GoTo NextRow

        Dim work_hours_val As Variant
        work_hours_val = work_time_tbl(row, WORK_HOURS_COL)
        If Not IsNumeric(work_hours_val) Then GoTo NextRow

        If Not tanmu_jikan_dic.Exists(shift_name) Then
            tanmu_jikan_dic.Add shift_name, CDbl(work_hours_val)
        End If

NextRow:
    Next row

    ' Return
    Set CreateTanmuJikanDic = tanmu_jikan_dic

End Function


Public Function CreateStaffShuKinmuJikanDic( _
    ByVal tanmu_tbl As Variant, _
    ByVal start_col As Long, _
    ByVal end_col As Long, _
    ByVal tanmu_jikan_dic As Scripting.Dictionary _
) As Scripting.Dictionary

    ' Description
    '   担務表（tanmu_tbl）を走査し、スタッフ×週（日曜基準）の勤務時間合計を集計した
    '   2段辞書を作成して返す。
    '
    '   staff_shu_kinmujikan_dic(staff)(week_start_date) = hours
    '
    ' Arguments
    '   tanmu_tbl       : 担務表シートを格納した配列
    '   start_col       : 週管理の対象開始列
    '   end_col         : 週管理の対象終了列
    '   tanmu_jikan_dic : シフト名（担務名）→勤務時間 の辞書
    '
    ' Returns
    '   Dictionary
    '
    ' Dependency Tree
    '   CreateStaffShuKinmuJikanDic
    '     └─ GetWeekStartDateFromDate


    ' 固定仕様（担務表）
    Const TANMU_SHIFT_NAME_COL As Long = 1   ' A列
    Const TANMU_DATE_ROW As Long = 1         ' 1行目
    Const TANMU_DATA_START_ROW As Long = 4   ' 4行目


    ' Return 用辞書
    Dim staff_shu_kinmujikan_dic As Scripting.Dictionary
    Set staff_shu_kinmujikan_dic = New Scripting.Dictionary


    ' 対象列×担務行を走査して集計
    '   担務表の列方向を走査
    Dim date_col As Long
    For date_col = start_col To end_col

        ' 日付取得
        Dim work_date As Date
        work_date = CDate(tanmu_tbl(TANMU_DATE_ROW, date_col))

        ' 週キー（日曜）算出
        Dim week_start_date As Date
        week_start_date = GetWeekStartDateFromDate(work_date)
        
        '  担務表（配列）の行方向を走査
        Dim tanmu_row As Long
        For tanmu_row = TANMU_DATA_START_ROW To UBound(tanmu_tbl, 1)

            ' シフト名（担務名）を取得
            Dim shift_name As String
            shift_name = Trim$(CStr(tanmu_tbl(tanmu_row, TANMU_SHIFT_NAME_COL)))
            If Len(shift_name) = 0 Then GoTo NextTanmuRow

            ' 勤務時間が定義されていないシフトは集計対象外
            If Not tanmu_jikan_dic.Exists(shift_name) Then GoTo NextTanmuRow
            
            ' シフト（担務）の標準勤務時間を取得
            Dim shift_hours As Double
            shift_hours = CDbl(tanmu_jikan_dic(shift_name))

            ' 担当者（略称）を取得（空欄は対象外）
            Dim staff As String
            staff = Trim$(CStr(tanmu_tbl(tanmu_row, date_col)))
            If Len(staff) = 0 Then GoTo NextTanmuRow

            ' 外側辞書：スタッフ未登録なら内側辞書を作成
            If Not staff_shu_kinmujikan_dic.Exists(staff) Then
                Dim inner_dic As Scripting.Dictionary
                Set inner_dic = New Scripting.Dictionary
                staff_shu_kinmujikan_dic.Add staff, inner_dic
            End If

            ' 内側辞書：スタッフ×週（日曜）単位のキーが未登録なら初期化
            '   staff_shu_kinmujikan_dic(staff)(week_start_date)
            '   の週合計を 0時間で作成する
            If Not staff_shu_kinmujikan_dic(staff).Exists(week_start_date) Then
                staff_shu_kinmujikan_dic(staff).Add week_start_date, 0#
            End If

            ' 週合計へ勤務時間を加算
            '   staff_shu_kinmujikan_dic(staff)(week_start_date)
            '   に当該シフト時間を加える
            staff_shu_kinmujikan_dic(staff)(week_start_date) = _
                CDbl(staff_shu_kinmujikan_dic(staff)(week_start_date)) + shift_hours

NextTanmuRow:
        Next tanmu_row

    Next date_col


    ' Return
    Set CreateStaffShuKinmuJikanDic = staff_shu_kinmujikan_dic

End Function


Public Function GetWeekStartDateFromDate(ByVal work_date As Date) As Date

    ' Description
    '   指定日が属する週の「日曜の日付」を返す。
    '
    ' Arguments
    '   work_date : 任意の日付
    '
    ' Returns
    '   Date
    '
    ' Dependency Tree
    '   (none)


    GetWeekStartDateFromDate = work_date - (Weekday(work_date, vbSunday) - 1)

End Function


Public Function CreateStaffMonthKinmuJikanDic( _
    ByVal tanmu_tbl As Variant, _
    ByVal target_year As Long, _
    ByVal target_month As Long, _
    ByVal tanmu_jikan_dic As Scripting.Dictionary _
) As Scripting.Dictionary

    ' Description
    '   担務表（tanmu_tbl）を走査し、対象月（target_year/target_month）の
    '   スタッフ別 月合計勤務時間辞書を作成して返す。
    '
    '   staff_month_kinmujikan_dic(staff) = hours
    '
    ' Arguments
    '   tanmu_tbl       : 担務表シートを格納した配列
    '   target_year     : 対象年
    '   target_month    : 対象月
    '   tanmu_jikan_dic : シフト名→勤務時間 の辞書
    '
    ' Returns
    '   Dictionary
    '
    ' Dependency Tree
    '   (none)


    ' 固定仕様（担務表）
    Const TANMU_SHIFT_NAME_COL As Long = 1   ' A列
    Const TANMU_DATE_ROW As Long = 1         ' 1行目
    Const TANMU_DATA_START_ROW As Long = 4   ' 4行目
    Const DATE_SEARCH_START_COL As Long = 2  ' B列（日付開始）


    ' Return 用辞書
    Dim staff_month_kinmujikan_dic As Scripting.Dictionary
    Set staff_month_kinmujikan_dic = New Scripting.Dictionary


    ' 日付行を走査し、対象月の列のみ集計
    Dim date_col As Long
    For date_col = DATE_SEARCH_START_COL To UBound(tanmu_tbl, 2)

        Dim date_text As String
        date_text = Trim$(CStr(tanmu_tbl(TANMU_DATE_ROW, date_col)))
        If Len(date_text) = 0 Then GoTo NextDateCol

        If Not IsDate(tanmu_tbl(TANMU_DATE_ROW, date_col)) Then GoTo NextDateCol

        Dim work_date As Date
        work_date = CDate(tanmu_tbl(TANMU_DATE_ROW, date_col))

        If Year(work_date) <> target_year Or Month(work_date) <> target_month Then
            GoTo NextDateCol
        End If


        ' 担務行を走査
        Dim tanmu_row As Long
        For tanmu_row = TANMU_DATA_START_ROW To UBound(tanmu_tbl, 1)

            Dim shift_name As String
            shift_name = Trim$(CStr(tanmu_tbl(tanmu_row, TANMU_SHIFT_NAME_COL)))
            If Len(shift_name) = 0 Then GoTo NextTanmuRow

            If Not tanmu_jikan_dic.Exists(shift_name) Then GoTo NextTanmuRow

            Dim staff As String
            staff = Trim$(CStr(tanmu_tbl(tanmu_row, date_col)))
            If Len(staff) = 0 Then GoTo NextTanmuRow

            Dim shift_hours As Double
            shift_hours = CDbl(tanmu_jikan_dic(shift_name))

            If Not staff_month_kinmujikan_dic.Exists(staff) Then
                staff_month_kinmujikan_dic.Add staff, 0#
            End If

            staff_month_kinmujikan_dic(staff) = _
                CDbl(staff_month_kinmujikan_dic(staff)) + shift_hours

NextTanmuRow:
        Next tanmu_row

NextDateCol:
    Next date_col


    ' Return
    Set CreateStaffMonthKinmuJikanDic = staff_month_kinmujikan_dic

End Function



' 辞書の中身をデバッグ表示するプロシージャ群
'------------------------------------------------------------------------------
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）
    Call DebugPrintNestedDic(staff_shift_kahi_dic, "シフト→可スタッフ辞書")

End Sub

Public Sub DebugPrintYoubiJoukenDic()
    
    ' Dependency Tree
    '   DebugPrintYoubiJoukenDic
    '     ├─ CreateYoubiJoukenDic
    '     └─ DebugPrintNestedDic

    ' シフト→曜日条件辞書を作成（辞書が取得できなかった場合は終了）
    Dim youbi_jouken_dic As Scripting.Dictionary
    Set youbi_jouken_dic = CreateYoubiJoukenDic()
    If youbi_jouken_dic Is Nothing Then Exit Sub

    ' 辞書の中身を確認（Debug.Print）
    Call DebugPrintNestedDic(youbi_jouken_dic, "シフト→曜日条件辞書")

End Sub

Public Sub DebugPrintTanmuJikanDic()

    ' シフト→勤務時間辞書を作成（辞書が取得できなかった場合は終了）
    Dim tanmu_jikan_dic As Scripting.Dictionary
    Set tanmu_jikan_dic = CreateTanmuJikanDic()
    If tanmu_jikan_dic Is Nothing Then Exit Sub

    ' 辞書の中身を確認（Debug.Print）
    Debug.Print "シフト→勤務時間辞書 : count=" & tanmu_jikan_dic.Count

    Dim shift_name As Variant
    For Each shift_name In tanmu_jikan_dic.Keys
        Debug.Print CStr(shift_name) & " : " & CDbl(tanmu_jikan_dic(shift_name))
    Next shift_name

End Sub

Public Sub DebugPrintCreateStaffShuKinmuJikanDic()

    ' Description
    '   担務表を読み込み、対象期間を取得し、週合計辞書を作成して Debug.Print に出力する。
    '
    ' Arguments
    '   (none)
    '
    ' Returns
    '   (none)
    '
    ' Dependency Tree
    '   TestCreateStaffShuKinmuJikanDic
    '     ├─ GetUsedRangeArray
    '     ├─ GetTaishoKikan
    '     ├─ CreateTanmuJikanDic
    '     └─ CreateStaffShuKinmuJikanDic


    ' 担務表配列取得
    Dim tanmu_ws As Worksheet
    Set tanmu_ws = ThisWorkbook.Worksheets("担務表")

    Dim tanmu_tbl As Variant
    tanmu_tbl = GetUsedRangeArray(tanmu_ws)

    ' 対象期間列（週管理対象）取得
    Dim start_col As Long
    Dim end_col As Long
    Call GetTaishoKikan(tanmu_tbl, start_col, end_col)

    ' 勤務時間辞書取得
    Dim tanmu_jikan_dic As Scripting.Dictionary
    Set tanmu_jikan_dic = CreateTanmuJikanDic()

    ' 週合計辞書作成
    Dim staff_shu_kinmujikan_dic As Scripting.Dictionary
    Set staff_shu_kinmujikan_dic = CreateStaffShuKinmuJikanDic( _
        tanmu_tbl, _
        start_col, _
        end_col, _
        tanmu_jikan_dic _
    )

    ' 出力（Debug.Print）
    Debug.Print "=== staff_shu_kinmujikan_dic ==="
    Debug.Print "start_col=" & start_col & " / end_col=" & end_col
    Debug.Print "staff_count=" & staff_shu_kinmujikan_dic.Count

    Dim staff As Variant
    For Each staff In staff_shu_kinmujikan_dic.Keys

        Debug.Print "staff=" & CStr(staff)

        Dim week_dic As Scripting.Dictionary
        Set week_dic = staff_shu_kinmujikan_dic(staff)

        Dim week_start_date As Variant
        For Each week_start_date In week_dic.Keys
            Debug.Print "  week_start=" & Format$(CDate(week_start_date), "yyyy/mm/dd") _
                        & " hours=" & CDbl(week_dic(week_start_date))
        Next week_start_date

    Next staff

End Sub


' ネストした辞書の中身を表示する汎用プロシージャ
'------------------------------------------------------------------------------
Public Sub DebugPrintNestedDic(ByVal outer_dic As Scripting.Dictionary, ByVal label As String)

    ' Description
    '   外側辞書の value が Dictionary である 2 段辞書を Debug.Print で出力する。
    '
    ' Arguments
    '   outer_dic : 外側辞書（value は Scripting.Dictionary を想定）
    '   label     : デバッグ出力用の識別子
    '
    ' Returns
    '   (none)
    '
    ' Dependency Tree
    '   DebugPrintNestedDic
    '     (none)


    ' ガード
    If outer_dic Is Nothing Then
        Debug.Print label & " : outer_dic is Nothing"
        Exit Sub
    End If


    ' 辞書の中身を確認（Debug.Print）
    '--------------------------------------------------------------------------
    Debug.Print label & " : count=" & outer_dic.Count

    Dim outer_key As Variant
    For Each outer_key In outer_dic.Keys

        Debug.Print outer_key

        ' 内側辞書を取得（辞書でなければスキップ）
        Dim inner_dic As Scripting.Dictionary
        On Error Resume Next
        Set inner_dic = outer_dic(outer_key)
        On Error GoTo 0
        If inner_dic Is Nothing Then GoTo NextOuterKey

        ' 内側辞書のキーを出力
        Dim inner_key As Variant
        For Each inner_key In inner_dic.Keys
            Debug.Print "  "; inner_key
        Next inner_key

NextOuterKey:
    Next outer_key

End Sub

Option Explicit


Public Sub CreateTanmuWs()

    ' Description
    '   シフト割当表から作成した「シフト名→可スタッフ辞書」を参照し、
    '   担務表の各日付×各シフトの未割当セルへ担当者名を割り当てる。
    '   曜日条件表（○）に一致するセルのみ割り当てる。
    '   候補者はシャッフルし、先頭要素を採用する（追加制約は入れない）。
    '
    '   追加仕様：
    '   週40時間上限を超える候補者は除外し、割当後は週合計辞書を即更新する。
    '
    ' Arguments
    '   (None)
    '
    ' Returns
    '   なし
    '
    ' Dependency Tree
    '   CreateTanmuWs
    '     ├─ GetUsedRangeArray
    '     ├─ DebugPrintArraySize
    '     ├─ CreateShiftWariateDic
    '     ├─ CreateYoubiJoukenDic
    '     ├─ GetTaishoKikan
    '     ├─ CreateTanmuJikanDic
    '     ├─ CreateStaffShuKinmuJikanDic
    '     ├─ GetWeekStartDateFromDate
    '     ├─ GetYoubiKeyFromTanmuHeader
    '     └─ ShuffleArrayByFisherYates


    ' 固定仕様（担務表）
    Const TANMU_SHEET_NAME       As String = "担務表"
    Const TANMU_SHIFT_NAME_COL   As Long = 1   ' A列
    Const TANMU_DATE_ROW         As Long = 1   ' 1行目
    Const TANMU_DATA_START_ROW   As Long = 4   ' 4行目
    Const WEEK_LIMIT_HOURS       As Double = 40#


    ' 担務表・シフト割当辞書の取得
    '--------------------------------------------------------------------------
    ' 担務表シートの取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(TANMU_SHEET_NAME)

    ' 担務表配列の取得
    Dim tanmu_tbl As Variant
    tanmu_tbl = GetUsedRangeArray(ws)
    Call DebugPrintArraySize(tanmu_tbl, "担務表配列")
    If IsEmpty(tanmu_tbl) Then Exit Sub

    ' シフト割当辞書の取得
    Dim staff_shift_kahi_dic As Scripting.Dictionary
    Set staff_shift_kahi_dic = CreateShiftWariateDic()
    If staff_shift_kahi_dic Is Nothing Then Exit Sub

    ' 曜日条件辞書の取得
    Dim youbi_jouken_dic As Scripting.Dictionary
    Set youbi_jouken_dic = CreateYoubiJoukenDic()
    If youbi_jouken_dic Is Nothing Then Exit Sub

    ' 週管理の対象列を取得
    Dim start_col As Long
    Dim end_col As Long
    Call GetTaishoKikan(tanmu_tbl, start_col, end_col)
    If start_col <= 0 Or end_col <= 0 Or start_col > end_col Then
        MsgBox "対象期間の取得に失敗しました。I列の日付を確認してください。", vbExclamation
        Exit Sub
    End If

    ' 勤務時間辞書の取得
    Dim tanmu_jikan_dic As Scripting.Dictionary
    Set tanmu_jikan_dic = CreateTanmuJikanDic()
    If tanmu_jikan_dic Is Nothing Then Exit Sub

    ' 週合計辞書（初期集計）を作成
    Dim staff_shu_kinmujikan_dic As Scripting.Dictionary
    Set staff_shu_kinmujikan_dic = CreateStaffShuKinmuJikanDic( _
        tanmu_tbl, _
        start_col, _
        end_col, _
        tanmu_jikan_dic _
    )
    If staff_shu_kinmujikan_dic Is Nothing Then Exit Sub


    ' 割当処理（日付列×担務行を走査）
    '--------------------------------------------------------------------------
    Dim assign_count As Long
    assign_count = 0

    ' 担務表配列の列方向を走査（週管理の対象列のみ）
    Dim date_col As Long
    For date_col = start_col To end_col

        ' 日付セルが空の列はスキップ（列の終端対策）
        Dim date_val As String
        date_val = Trim$(CStr(tanmu_tbl(TANMU_DATE_ROW, date_col)))
        If Len(date_val) = 0 Then GoTo NextDateCol

        ' 日付取得
        Dim work_date As Date
        work_date = CDate(tanmu_tbl(TANMU_DATE_ROW, date_col))

        ' 週キー（日曜）算出
        Dim week_start_date As Date
        week_start_date = GetWeekStartDateFromDate(work_date)

        ' 曜日キーを取得（祝日優先）
        Dim youbi_key As String
        youbi_key = GetYoubiKeyFromTanmuHeader(tanmu_tbl, date_col)
        If Len(youbi_key) = 0 Then GoTo NextDateCol

        ' 担務表配列の行方向を走査
        Dim tanmu_row As Long
        For tanmu_row = TANMU_DATA_START_ROW To UBound(tanmu_tbl, 1)

            ' 担務表からシフト名を取得（空欄は対象外）
            Dim shift_name As String
            shift_name = Trim$(CStr(tanmu_tbl(tanmu_row, TANMU_SHIFT_NAME_COL)))
            If Len(shift_name) = 0 Then GoTo NextTanmuRow

            ' 曜日条件（○）に一致しないセルは割当対象外:
            '   現在のシフト名が曜日条件表に定義されていない場合
            If Not youbi_jouken_dic.Exists(shift_name) Then GoTo NextTanmuRow

            '   現在の曜日（または祝日）がシフト曜日条件に該当していない場合
            If Not youbi_jouken_dic(shift_name).Exists(youbi_key) Then GoTo NextTanmuRow

            ' 既に値が入っているセルは変更しない
            Dim cell_value As String
            cell_value = Trim$(CStr(tanmu_tbl(tanmu_row, date_col)))
            If Len(cell_value) > 0 Then GoTo NextTanmuRow

            ' シフト割当辞書にシフト名が存在しない場合はスキップ
            If Not staff_shift_kahi_dic.Exists(shift_name) Then GoTo NextTanmuRow

            ' 勤務時間が定義されていないシフトは割当対象外
            If Not tanmu_jikan_dic.Exists(shift_name) Then GoTo NextTanmuRow

            ' 対象シフトの標準勤務時間を取得
            Dim shift_hours As Double
            shift_hours = CDbl(tanmu_jikan_dic(shift_name))

            ' 対象シフトに割り当て可能なスタッフ辞書を取得（取得できない場合はスキップ）
            Dim assignable_staff_dic As Scripting.Dictionary
            Set assignable_staff_dic = staff_shift_kahi_dic(shift_name)
            If assignable_staff_dic Is Nothing Then GoTo NextTanmuRow

            ' 可スタッフが存在しない場合は割当対象外
            Dim staff_count As Long    ' 割り当て可能なスタッフの人数
            staff_count = assignable_staff_dic.Count
            If staff_count = 0 Then GoTo NextTanmuRow

            ' 可スタッフ辞書のキー（スタッフ略称一覧）を配列として取得（0始まり）
            Dim shift_assignable_staff As Variant
            shift_assignable_staff = assignable_staff_dic.Keys

            ' 週40h制御：条件を満たす候補者のみ配列に格納（1回ループで作成）
            Dim candidate_list() As Variant
            ReDim candidate_list(1 To (UBound(shift_assignable_staff) - LBound(shift_assignable_staff) + 1))

            Dim candidate_idx As Long
            candidate_idx = 0

            Dim key_idx As Long
            Dim candidate_staff As String
            Dim candidate_week_hours As Double

            For key_idx = LBound(shift_assignable_staff) To UBound(shift_assignable_staff)

                ' 候補者（スタッフ略称）を取得（空は除外）
                candidate_staff = Trim$(CStr(shift_assignable_staff(key_idx)))
                If Len(candidate_staff) = 0 Then GoTo NextKeyIdx

                ' 当該週の累計勤務時間を取得（未登録なら0時間）
                candidate_week_hours = 0#

                If staff_shu_kinmujikan_dic.Exists(candidate_staff) Then
                    If staff_shu_kinmujikan_dic(candidate_staff).Exists(week_start_date) Then
                        candidate_week_hours = CDbl(staff_shu_kinmujikan_dic(candidate_staff)(week_start_date))
                    End If
                End If

                ' 今回のシフト時間を加算しても週上限以内なら候補として格納
                If (candidate_week_hours + shift_hours) <= WEEK_LIMIT_HOURS Then
                    candidate_idx = candidate_idx + 1
                    candidate_list(candidate_idx) = candidate_staff
                End If

NextKeyIdx:
            Next key_idx

            ' 条件を満たす候補が0人なら割当しない
            If candidate_idx = 0 Then GoTo NextTanmuRow

            ' 候補者リスト配列を候補数に切り詰め
            If candidate_idx < UBound(candidate_list) Then
                ReDim Preserve candidate_list(1 To candidate_idx)
            End If

            ' 候補者をシャッフル
            Dim shuffled_list As Variant
            shuffled_list = ShuffleArrayByFisherYates(candidate_list)

            ' シャッフル後の先頭を採用
            Dim assigned_staff As String
            assigned_staff = Trim$(CStr(shuffled_list(1)))

            If Len(assigned_staff) > 0 Then

                ' 担務表配列に略称を書き込む
                tanmu_tbl(tanmu_row, date_col) = assigned_staff
                assign_count = assign_count + 1

                ' 週合計辞書を即更新
                If Not staff_shu_kinmujikan_dic.Exists(assigned_staff) Then
                    Dim inner_dic As Scripting.Dictionary
                    Set inner_dic = New Scripting.Dictionary
                    staff_shu_kinmujikan_dic.Add assigned_staff, inner_dic
                End If

                If Not staff_shu_kinmujikan_dic(assigned_staff).Exists(week_start_date) Then
                    staff_shu_kinmujikan_dic(assigned_staff).Add week_start_date, 0#
                End If

                staff_shu_kinmujikan_dic(assigned_staff)(week_start_date) = _
                    CDbl(staff_shu_kinmujikan_dic(assigned_staff)(week_start_date)) + shift_hours

            End If

NextTanmuRow:
        Next tanmu_row

NextDateCol:
    Next date_col


    ' 担務表シートに書き戻し
    '--------------------------------------------------------------------------
    ws.Range( _
        ws.Cells(1, 1), _
        ws.Cells(UBound(tanmu_tbl, 1), UBound(tanmu_tbl, 2)) _
    ).Value = tanmu_tbl

    Debug.Print "担務表 割当 件数 = " & assign_count

    ' 勤務時間情報をシート出力
    Call WriteWeekWorkTimeSummaryToTanmuWs

End Sub


Private Function GetYoubiKeyFromTanmuHeader( _
    ByVal tanmu_header_tbl As Variant, _
    ByVal target_col As Long _
) As String

    ' Description
    '   担務表ヘッダ配列の指定列から、曜日条件判定に使用するキー（曜日 or 祝）を返す。
    '   祝日行に値が入っている場合は曜日よりも祝日判定を優先し、「祝」を返す。
    '
    ' Arguments
    '   tanmu_header_tbl : 担務表ヘッダを格納した2次元配列
    '   target_col       : 対象列（担務表ヘッダ配列の列番号）
    '
    ' Returns
    '   String
    '     - 祝日行に値が入っている場合 : "祝"
    '     - それ以外の場合             : 曜日行の文字列（例："月"）
    '
    ' Dependency Tree
    '   GetYoubiKeyFromTanmuHeader
    '     (none)


    ' 固定仕様（担務表ヘッダ）
    Const YOUBI_ROW As Long = 2
    Const SHUKUJITSU_ROW As Long = 3

    ' 祝日優先：祝日行に値があれば「祝」
    Dim shukujitsu_val As String
    shukujitsu_val = Trim$(CStr(tanmu_header_tbl(SHUKUJITSU_ROW, target_col)))
    If Len(shukujitsu_val) > 0 Then
        GetYoubiKeyFromTanmuHeader = "祝"
        Exit Function
    End If

    ' 祝日でない場合：曜日行の値を返す
    GetYoubiKeyFromTanmuHeader = _
        Trim$(CStr(tanmu_header_tbl(YOUBI_ROW, target_col)))

End Function

Option Explicit


Public Sub WriteWeekWorkTimeSummaryToTanmuWs()

    ' Description
    '   担務表の週合計勤務時間を集計し、担務表の下部に表形式で出力する。
    '   表の形は「行＝スタッフ」「列＝週（日曜始まり）」「値＝週合計時間（hours）」とする。
    '
    ' Arguments
    '   (none)
    '
    ' Returns
    '   (none)
    '
    ' Dependency Tree
    '   WriteWeekWorkTimeSummaryToTanmuWs
    '     ├─ GetUsedRangeArray
    '     ├─ GetTaishoKikan
    '     ├─ CreateTanmuJikanDic
    '     ├─ CreateStaffShuKinmuJikanDic
    '     └─ GetRyakushoList


    ' 定数
    '--------------------------------------------------------------------------
    ' 固定仕様（シート名）
    Const TANMU_SHEET_NAME As String = "担務表"
    Const SHIFT_WARIATE_SHEET_NAME As String = "シフト割当表"

    ' 固定仕様（シフト割当表）
    Const SHIFT_WARIATE_DATA_START_ROW As Long = 2
    Const SHIFT_WARIATE_STAFF_RYAKUSHO_COL As Long = 2   ' B列

    
    ' 各種データ取得（シート / 配列 / 辞書）
    ' -------------------------------------------------------------------------
    ' 担務表配列取得
    Dim tanmu_ws As Worksheet
    Set tanmu_ws = ThisWorkbook.Worksheets(TANMU_SHEET_NAME)

    Dim tanmu_tbl As Variant
    tanmu_tbl = GetUsedRangeArray(tanmu_ws)
    
    If IsEmpty(tanmu_tbl) Then
        MsgBox "担務表にデータが存在しません。処理を中止します。", vbExclamation
        Exit Sub
    End If
    
    
    ' 担務表から対象期間を取得
    Dim start_col As Long
    Dim end_col As Long
    Call GetTaishoKikan(tanmu_tbl, start_col, end_col)
    
    If start_col <= 0 Or end_col <= 0 Or start_col > end_col Then
        MsgBox "対象期間の取得に失敗しました。I列の日付を確認してください。", _
        vbExclamation
        Exit Sub
    End If


    ' 各シフトの標準勤務時間辞書を取得
    Dim tanmu_jikan_dic As Scripting.Dictionary
    Set tanmu_jikan_dic = CreateTanmuJikanDic()
    
    If tanmu_jikan_dic Is Nothing Then
        MsgBox "勤務時間表から勤務時間辞書を取得できませんでした。" & _
               "勤務時間表の内容を確認してください。", _
               vbExclamation
        Exit Sub
    End If


    ' スタッフ略称一覧配列を取得（全スタッフ対象）
    Dim shift_wariate_ws As Worksheet
    Set shift_wariate_ws = ThisWorkbook.Worksheets(SHIFT_WARIATE_SHEET_NAME)

    Dim staff_list As Variant
    staff_list = GetRyakushoList( _
        shift_wariate_ws, _
        SHIFT_WARIATE_DATA_START_ROW, _
        SHIFT_WARIATE_STAFF_RYAKUSHO_COL _
    )
    
    If IsEmpty(staff_list) Then
        MsgBox "シフト割当表からスタッフ略称を取得できませんでした。" & _
               "略称列（B列）を確認してください。", _
               vbExclamation
        Exit Sub
    End If

    '各週の勤務時間合計を取得
    '--------------------------------------------------------------------------
    ' 週勤務時間合計辞書を作成（スタッフ×週→合計時間）
    ' 例）
    ' staff_shu_kinmujikan_dic
    ' │
    ' ├─ "山田"
    ' │    ├─ #2026/03/29# → 32
    ' │    ├─ #2026/04/05# → 40
    ' │    ├─ #2026/04/12# → 24
    ' │    ├─ #2026/04/19# → 40
    ' │    └─ #2026/04/26# → 16
    Dim staff_shu_kinmujikan_dic As Scripting.Dictionary
    Set staff_shu_kinmujikan_dic = CreateStaffShuKinmuJikanDic( _
        tanmu_tbl, _
        start_col, _
        end_col, _
        tanmu_jikan_dic _
    )
    
    
    ' 出力準備
    '--------------------------------------------------------------------------
    ' 週キー（日曜）一覧を作成（start_col から end_col を 7列刻み）
    ' ※「\」は整数除算（小数点以下を切り捨てる割り算）
    Dim week_count As Long
    week_count = ((end_col - start_col) \ 7) + 1

    Dim week_list() As Variant
    ReDim week_list(1 To week_count)

    Dim wk_idx As Long
    For wk_idx = 1 To week_count

        Dim date_col As Long
        date_col = start_col + (wk_idx - 1) * 7

        week_list(wk_idx) = CDate(tanmu_tbl(1, date_col))

    Next wk_idx


    ' 出力位置を決定（担務表A列最終行 + 3行：空白2行）
    Dim last_row As Long
    last_row = tanmu_ws.Cells(tanmu_ws.Rows.Count, 1).End(xlUp).row

    Dim output_start_row As Long
    output_start_row = last_row + 3


    ' スタッフ略称の件数を取得
    Dim staff_count As Long
    staff_count = UBound(staff_list)

    ' 出力用配列を作成し値を詰める（確認1行＋ヘッダ1行＋スタッフ行 / スタッフ列1＋週列）
    ' ※ヘッダ行、確認行を含めるために +2
    Dim out_tbl() As Variant
    ReDim out_tbl(1 To (staff_count + 2), 1 To (week_count + 1))

    ' 確認行（1行目）
    out_tbl(1, 1) = "確認"
    
    ' ヘッダ行（2行目）
    out_tbl(2, 1) = "週合計"

    ' ヘッダ行に週開始日（日曜）を設定する
    For wk_idx = 1 To week_count
        out_tbl(2, wk_idx + 1) = CDate(week_list(wk_idx))
    Next wk_idx
    
    ' 辞書の中身を配列に詰め替え
    '   各スタッフを走査
    Dim staff_idx As Long
    For staff_idx = 1 To staff_count
    
        ' 現在処理中のスタッフ略称を取得
        Dim staff_ryakusho As String
        staff_ryakusho = CStr(staff_list(staff_idx))
    
        ' 行見出し（確認行＋ヘッダ行分 +2）
        out_tbl(staff_idx + 2, 1) = staff_ryakusho
    
        ' 週合計辞書に当該スタッフが存在するか確認
        If staff_shu_kinmujikan_dic.Exists(staff_ryakusho) Then
    
            ' スタッフ別の週合計辞書を取得
            Dim inner_dic As Scripting.Dictionary
            Set inner_dic = staff_shu_kinmujikan_dic(staff_ryakusho)
    
            ' 各週ごとの合計時間を配列に設定
            For wk_idx = 1 To week_count
    
                ' 現在の週キー（日曜）を取得
                Dim week_key As Date
                week_key = CDate(week_list(wk_idx))
    
                ' 当該週のデータが存在する場合はその値を設定
                ' 存在しない場合は 0 を設定
                If inner_dic.Exists(week_key) Then
                    out_tbl(staff_idx + 2, wk_idx + 1) = CDbl(inner_dic(week_key))
                Else
                    out_tbl(staff_idx + 2, wk_idx + 1) = 0#
                End If
    
            Next wk_idx
    
        Else
    
            ' 週合計辞書に存在しないスタッフは全週 0 とする
            For wk_idx = 1 To week_count
                out_tbl(staff_idx + 2, wk_idx + 1) = 0#
            Next wk_idx
    
        End If
    
    Next staff_idx

    ' 出力範囲の設定
    '--------------------------------------------------------------------------
    ' 出力列設定
    Const OUTPUT_START_COL As Long = 9   ' I列

    ' 出力行 / 出力列 取得
    Dim out_last_row As Long
    out_last_row = output_start_row + UBound(out_tbl, 1) - 1

    Dim out_last_col As Long
    out_last_col = OUTPUT_START_COL + UBound(out_tbl, 2) - 1

    ' 出力範囲を取得
    Dim out_rng As Range
    Set out_rng = tanmu_ws.Range( _
        tanmu_ws.Cells(output_start_row, OUTPUT_START_COL), _
        tanmu_ws.Cells(out_last_row, out_last_col) _
    )


    ' 前回出力範囲のクリア（固定範囲）
    '---------------------------------------------------------------------------
    ' 週数は最大6週とし、固定範囲を毎回クリアする
    Const MAX_WEEK_COUNT As Long = 6
    
    Dim week_output_last_row As Long
    week_output_last_row = output_start_row + (staff_count + 1)   ' 確認+ヘッダ+スタッフ行
    
    Dim week_output_last_col As Long
    week_output_last_col = OUTPUT_START_COL + MAX_WEEK_COUNT      ' I列 + 6 = O列
    
    tanmu_ws.Range( _
        tanmu_ws.Cells(output_start_row, OUTPUT_START_COL), _
        tanmu_ws.Cells(week_output_last_row, week_output_last_col) _
    ).ClearContents
    
    tanmu_ws.Range( _
        tanmu_ws.Cells(output_start_row, OUTPUT_START_COL), _
        tanmu_ws.Cells(week_output_last_row, week_output_last_col) _
    ).NumberFormat = "General"

    
    ' シートへ書き込み
    '--------------------------------------------------------------------------
    ' 担務表へ一括書き込み
    out_rng.Value2 = out_tbl
    
    ' ヘッダ行（2行目）の週開始日だけ表示形式を変更
    out_rng.Offset(1, 1).Resize(1, week_count).NumberFormat = "m/d"
    
    ' スタッフ列（1列目）を左寄せ（全行）
    out_rng.Columns(1).HorizontalAlignment = xlLeft

    ' 勤務時間列（2列目以降）を右寄せ（ヘッダ行から下）
    ' ※確認行は除外するため高さは -1
    out_rng.Offset(1, 1).Resize(UBound(out_tbl, 1) - 1, week_count) _
        .HorizontalAlignment = xlRight

End Sub


Public Sub WriteMonthWorkTimeSummaryToTanmuWs()

    ' Description
    '   担務表の月合計勤務時間を集計し、担務表の下部に表形式で出力する。
    '   対象月は「担務表 I列（日付行）の月」とする。
    '   表の形は「行＝スタッフ」「列＝月合計（hours）」とする。
    '
    ' Arguments
    '   (none)
    '
    ' Returns
    '   (none)
    '
    ' Dependency Tree
    '   WriteMonthWorkTimeSummaryToTanmuWs
    '     ├─ GetUsedRangeArray
    '     ├─ CreateTanmuJikanDic
    '     ├─ GetRyakushoList
    '     └─ CreateStaffMonthKinmuJikanDic


    ' 固定値設定
    '--------------------------------------------------------------------------
    ' 固定仕様（シート名）
    Const TANMU_SHEET_NAME As String = "担務表"
    Const SHIFT_WARIATE_SHEET_NAME As String = "シフト割当表"

    ' 固定仕様（担務表）
    Const TANMU_DATE_ROW As Long = 1
    Const TARGET_DATE_COL As Long = 9          ' I列
    Const OUTPUT_START_COL As Long = 9         ' I列

    ' 固定仕様（シフト割当表）
    Const SHIFT_WARIATE_DATA_START_ROW As Long = 2
    Const SHIFT_WARIATE_STAFF_RYAKUSHO_COL As Long = 2   ' B列


    ' 各種データ取得
    '--------------------------------------------------------------------------
    ' 担務表配列取得
    Dim tanmu_ws As Worksheet
    Set tanmu_ws = ThisWorkbook.Worksheets(TANMU_SHEET_NAME)

    Dim tanmu_tbl As Variant
    tanmu_tbl = GetUsedRangeArray(tanmu_ws)

    If IsEmpty(tanmu_tbl) Then
        MsgBox "担務表にデータが存在しません。処理を中止します。", vbExclamation
        Exit Sub
    End If


    ' 対象月の取得（I列の日付）
    Dim target_date_val As Variant
    target_date_val = tanmu_tbl(TANMU_DATE_ROW, TARGET_DATE_COL)

    If Not IsDate(target_date_val) Then
        MsgBox "担務表 I列（1行目）の日付が不正です。", vbExclamation
        Exit Sub
    End If

    Dim target_date As Date
    target_date = CDate(target_date_val)

    Dim target_year As Long
    target_year = Year(target_date)

    Dim target_month As Long
    target_month = Month(target_date)


    ' 各シフトの標準勤務時間辞書を取得
    Dim tanmu_jikan_dic As Scripting.Dictionary
    Set tanmu_jikan_dic = CreateTanmuJikanDic()

    If tanmu_jikan_dic Is Nothing Then
        MsgBox "勤務時間表から勤務時間辞書を取得できませんでした。" & _
               "勤務時間表の内容を確認してください。", _
               vbExclamation
        Exit Sub
    End If


    ' スタッフ略称一覧配列を取得（全スタッフ対象）
    Dim shift_wariate_ws As Worksheet
    Set shift_wariate_ws = ThisWorkbook.Worksheets(SHIFT_WARIATE_SHEET_NAME)

    Dim staff_list As Variant
    staff_list = GetRyakushoList( _
        shift_wariate_ws, _
        SHIFT_WARIATE_DATA_START_ROW, _
        SHIFT_WARIATE_STAFF_RYAKUSHO_COL _
    )

    If IsEmpty(staff_list) Then
        MsgBox "シフト割当表からスタッフ略称を取得できませんでした。" & _
               "略称列（B列）を確認してください。", _
               vbExclamation
        Exit Sub
    End If
    
    ' スタッフ略称の件数を取得
    Dim staff_count As Long
    staff_count = UBound(staff_list)


    ' 月勤務時間合計辞書を作成（スタッフ→月合計時間）
    Dim staff_month_kinmujikan_dic As Scripting.Dictionary
    Set staff_month_kinmujikan_dic = CreateStaffMonthKinmuJikanDic( _
        tanmu_tbl, _
        target_year, _
        target_month, _
        tanmu_jikan_dic _
    )


    ' 出力位置を決定（週合計の右隣）
    '--------------------------------------------------------------------------
    ' 週合計と同じ開始行（担務表A列最終行 + 3）
    Dim last_row As Long
    last_row = tanmu_ws.Cells(tanmu_ws.Rows.Count, 1).End(xlUp).row
    
    Dim output_start_row As Long
    output_start_row = last_row + 3
    
    ' 月合計の開始列（週合計 I～O の右隣、2列空けて開始）
    Const MAX_WEEK_COUNT As Long = 6
    Const MONTH_OUTPUT_START_COL As Long = OUTPUT_START_COL + MAX_WEEK_COUNT + 3

    
    ' 出力用配列を作成（確認1行＋ヘッダ1行＋スタッフ行 / スタッフ列1＋合計列1）
    '--------------------------------------------------------------------------
    ' 出力用配列のサイズを調整
    Dim out_tbl() As Variant
    ReDim out_tbl(1 To (staff_count + 2), 1 To 2)

    ' 確認行（1行目）
    out_tbl(1, 1) = "確認"

    ' ヘッダ行（2行目）
    out_tbl(2, 1) = "月合計"
    out_tbl(2, 2) = DateSerial(target_year, target_month, 1)

    ' 各スタッフを走査
    Dim staff_idx As Long
    For staff_idx = 1 To staff_count

        Dim staff_ryakusho As String
        staff_ryakusho = CStr(staff_list(staff_idx))

        out_tbl(staff_idx + 2, 1) = staff_ryakusho

        If staff_month_kinmujikan_dic.Exists(staff_ryakusho) Then
            out_tbl(staff_idx + 2, 2) = CDbl(staff_month_kinmujikan_dic(staff_ryakusho))
        Else
            out_tbl(staff_idx + 2, 2) = 0#
        End If

    Next staff_idx


    ' 出力範囲の設定（固定開始列）
    '--------------------------------------------------------------------------
    Dim out_last_row As Long
    out_last_row = output_start_row + UBound(out_tbl, 1) - 1
    
    Dim out_last_col As Long
    out_last_col = MONTH_OUTPUT_START_COL + UBound(out_tbl, 2) - 1
    
    Dim out_rng As Range
    Set out_rng = tanmu_ws.Range( _
        tanmu_ws.Cells(output_start_row, MONTH_OUTPUT_START_COL), _
        tanmu_ws.Cells(out_last_row, out_last_col) _
    )
    
    ' 前回出力範囲のクリア（固定範囲）
    '--------------------------------------------------------------------------
    Dim month_output_last_row As Long
    month_output_last_row = output_start_row + (staff_count + 1)   ' 確認+ヘッダ+スタッフ行
    
    Dim month_output_last_col As Long
    month_output_last_col = MONTH_OUTPUT_START_COL + 1             ' スタッフ列 + 合計列
    
    tanmu_ws.Range( _
        tanmu_ws.Cells(output_start_row, MONTH_OUTPUT_START_COL), _
        tanmu_ws.Cells(month_output_last_row, month_output_last_col) _
    ).ClearContents
    
    tanmu_ws.Range( _
        tanmu_ws.Cells(output_start_row, MONTH_OUTPUT_START_COL), _
        tanmu_ws.Cells(month_output_last_row, month_output_last_col) _
    ).NumberFormat = "General"


    ' シートへ書き込み
    '--------------------------------------------------------------------------
    ' 担務表へ一括書き込み
    out_rng.Value2 = out_tbl

    ' ヘッダ（月）だけ表示形式を変更
    out_rng.Offset(1, 1).Resize(1, 1).NumberFormat = "m/d"

    ' スタッフ列（1列目）を左寄せ（全行）
    out_rng.Columns(1).HorizontalAlignment = xlLeft

    ' 合計列（2列目）を右寄せ（ヘッダ行から下）
    out_rng.Offset(1, 1).Resize(UBound(out_tbl, 1) - 1, 1) _
        .HorizontalAlignment = xlRight


End Sub


Private Function GetRyakushoList( _
    ByVal shift_wariate_ws As Worksheet, _
    ByVal data_start_row As Long, _
    ByVal staff_ryakusho_col As Long _
) As Variant

    ' Description
    '   シフト割当表のスタッフ略称列を走査し、全スタッフ略称（重複除外）を1始まり配列で返す。
    '   表示順はシート上の出現順を維持する。
    '
    ' Arguments
    '   shift_wariate_ws    : シフト割当表シート
    '   data_start_row      : データ開始行
    '   staff_ryakusho_col  : スタッフ略称列（例：B列=2）
    '
    ' Returns
    '   Variant
    '     - 1始まりのスタッフ略称配列
    '     - 取得できない場合は Empty
    '
    ' Dependency Tree
    '    (none)


    ' 最終行を取得（略称列基準）
    Dim last_row As Long
    last_row = shift_wariate_ws.Cells( _
        shift_wariate_ws.Rows.Count, staff_ryakusho_col _
    ).End(xlUp).row
    
    ' 略称データが存在しない場合は 0件として Empty を返す
    ' ※ユーザー通知（MsgBox）は呼び出し側で行う
    If last_row < data_start_row Then
        GetRyakushoList = Empty
        Exit Function
    End If

    ' 一意のスタッフ略称を保持するための辞書を作成
    Dim unique_staff_dic As Scripting.Dictionary
    Set unique_staff_dic = New Scripting.Dictionary

    ' 最大想定件数で一次配列を確保する
    ' ※実際の件数は staff_count で管理し、後で詰め直す
    Dim max_count As Long    ' 最大件数
    max_count = last_row - data_start_row + 1
    
    ' 一時格納用スタッフリスト（配列）
    Dim temp_staff_list() As Variant
    ReDim temp_staff_list(1 To max_count)

    ' 実際に登録されたスタッフ件数
    Dim staff_count As Long
    staff_count = 0

    ' 略称列を配列で取得
    Dim ryakusho_tbl As Variant
    ryakusho_tbl = shift_wariate_ws.Range( _
        shift_wariate_ws.Cells(data_start_row, staff_ryakusho_col), _
        shift_wariate_ws.Cells(last_row, staff_ryakusho_col) _
    ).Value2

    ' 略称列（配列）を走査
    Dim row As Long
    For row = 1 To UBound(ryakusho_tbl, 1)
    
        ' 現在の略称を取得（前後空白除去）
        Dim staff_ryakusho As String
        staff_ryakusho = Trim$(CStr(ryakusho_tbl(row, 1)))
    
        ' 空欄は対象外
        If Len(staff_ryakusho) = 0 Then GoTo NextRow
    
        ' まだ登録していない略称のみ追加（重複排除）
        If Not unique_staff_dic.Exists(staff_ryakusho) Then
            unique_staff_dic.Add staff_ryakusho, True
    
            staff_count = staff_count + 1
            temp_staff_list(staff_count) = staff_ryakusho
        End If
    
NextRow:
    Next row
    
    
    ' 取得件数で詰め直す（1始まり維持）
    Dim staff_list() As Variant
    ReDim staff_list(1 To staff_count)

    Dim idx As Long
    For idx = 1 To staff_count
        staff_list(idx) = temp_staff_list(idx)
    Next idx
    
    ' Return
    GetRyakushoList = staff_list

End Function

Option Explicit


' 配列操作関連プロシージャ
'------------------------------------------------------------------------------
Sub DebugPrintArraySize(ByVal arr As Variant, ByVal label As String)

    ' Description
    ' 配列の行要素数・列要素数をイミディエイトウィンドウに出力する
    '
    ' Arguments
    ' arr   : 行列構造を持つ配列
    ' label : デバッグ出力用の識別子（シート名など）
    '
    ' Dependency Tree
    '    (none)


    ' 配列が Empty の場合処理を中断する
    If IsEmpty(arr) Then
        Debug.Print label & " : 配列が Empty です"
        Exit Sub
    End If

    ' 配列の行要素数・列要素数を出力
    Debug.Print label & _
                " 行要素数=" & (UBound(arr, 1) - LBound(arr, 1) + 1) & _
                " 列要素数=" & (UBound(arr, 2) - LBound(arr, 2) + 1)

End Sub


Function GetUsedRangeArray(ByVal ws As Worksheet) As Variant
    
    ' Description
    '   指定されたワークシートの使用範囲を判定し、
    '   Cells(1,1) から最終行・最終列までを配列として返す
    '
    ' Arguments
    '   ws  : 対象となるワークシート
    '
    ' Returns
    '   Variant
    '     ・使用範囲が存在する場合：
    '         Cells(1,1) ～ 最終行・最終列 を格納した 2 次元配列
    '     ・シートにデータが存在しない場合：
    '         Empty
    '
    ' Dependency Tree
    '     (none)
    

    ' シートにデータが存在しない場合は Empty を返す
    If ws.Cells.Find("*") Is Nothing Then
        GetUsedRangeArray = Empty
        Exit Function
    End If


    ' 最終行・最終列の取得
    Dim last_row As Long
    Dim last_col As Long

    With ws
        last_row = .Cells.Find( _
                        "*", _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious _
                    ).row

        last_col = .Cells.Find( _
                        "*", _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious _
                    ).Column
    End With


    ' Return：使用範囲を配列として返す
    GetUsedRangeArray = _
        ws.Range( _
            ws.Cells(1, 1), _
            ws.Cells(last_row, last_col) _
        ).Value

End Function

Option Explicit


' シャッフル関連プロシージャ
'------------------------------------------------------------------------------
Function ShuffleArrayByFisherYates( _
    ByVal src_arr As Variant _
) As Variant

    ' Description
    '   指定された配列全体を対象に、
    '   フィッシャー・イェーツ法でランダムに並び替えた
    '   新しい配列を返却する
    '
    '   ・元の配列は変更しない
    '   ・要素数が 0 または 1 の場合は並び替えを行わない
    '
    ' Arguments
    '   src_arr : 並び替え対象の配列（1始まり想定）
    '
    ' Returns
    '   Variant
    '     - ランダムに並び替えられた配列
    '
    ' Dependency Tree
    '   (none)


    ' 有効要素数を取得
    Dim arr_count As Long
    arr_count = UBound(src_arr)

    ' ガード
    If arr_count <= 1 Then
        ShuffleArrayByFisherYates = src_arr
        Exit Function
    End If


    ' 作業用配列を初期化（有効要素分のみ）
    Dim work_arr() As Variant   ' 作業用配列
    ReDim work_arr(1 To arr_count)


    ' 元配列からコピー
    Dim i As Long
    For i = 1 To arr_count
        work_arr(i) = src_arr(i)
    Next i


    ' フィッシャー・イェーツシャッフル
    For i = arr_count To 2 Step -1

        Dim j As Long
        j = Int(Rnd * i) + 1

        Dim tmp As Variant
        tmp = work_arr(i)
        work_arr(i) = work_arr(j)
        work_arr(j) = tmp

    Next i


    ' Return
    ShuffleArrayByFisherYates = work_arr

End Function