【Excel VBA 再利用コード集】シフト表ヘッダ部に祝日を反映する処理（配列利用）

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

Option Explicit


Public Sub AddShukujisuToTanmuWs()

    ' Description
    '   担務表ヘッダ配列に祝日情報を反映し、シートへ書き戻す。
    '
    ' Arguments
    '   (none)
    '
    ' Returns
    '   (none)


    ' 担務表シート取得
    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(tanmu_header_tbl) Or (Not IsArray(tanmu_header_tbl)) Then
        MsgBox "tanmu_header_tbl が取得できません。", vbExclamation
        Exit Sub
    End If

    If IsEmpty(shukujitsu_tbl) Or (Not IsArray(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最終行」までを、配列として取得する

    ' 祝日シートを取得
    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)
    
    
    ' ガード（空配列など）
    If IsEmpty(tanmu_header_tbl) Or (Not IsArray(tanmu_header_tbl)) Then
        MsgBox "tanmu_header_tbl が Empty / 配列ではありません。", vbExclamation
        Exit Sub
    End If

    If IsEmpty(shukujitsu_tbl) Or (Not IsArray(shukujitsu_tbl)) Then
        MsgBox "shukujitsu_tbl が Empty / 配列ではありません。", vbExclamation
        Exit Sub
    End If


    ' 固定仕様（担務表ヘッダ）
    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

Option Explicit


' 配列操作関連プロシージャ
'------------------------------------------------------------------------------

Sub DebugPrintArraySize(ByVal arr As Variant, ByVal label As String)

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


    ' 配列が 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
    

    ' シートにデータが存在しない場合は Empty を返す
    If ws.Cells.Find("*") Is Nothing Then
        GetUsedRangeArray = Empty
        MsgBox "シートにデータが存在しません。", vbExclamation
        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