【VBA】シフト表（勤務表）をExcelで自動作成する方法（コピペOK）

VBA

2026.04.252026.04.26

この記事でできること
どんな場面で使う？
完成イメージ（Before / After）
実行前の準備
1. バックアップを取る
2. Excelをマクロ有効ブック（.xlsm）で保存する
手順（コピペ → 実行まで約5分）
コード（最小版）– 月のカレンダー＋土日色分け
1. 書き換えポイント
2. コードの流れ
コード（実務版）– スタッフ×日付マトリックス＋シフト色分け＋人数集計＋祝日対応
落とし穴
1. VBAでシフト表の色分けが反映されないときの対処法
2. VBAでシフト表のCOUNTIF集計が合わないときの対処法
FAQ
まとめ
次にやりたくなること

この記事でできること

VBAで指定月のカレンダーを自動生成し、土日を色分けできる
スタッフ一覧×日付のマトリックス形式でシフト表を自動作成できる
シフトパターンの色分け、人数集計行、祝日対応まで実装できる

対象: Excel 2016以降 / Microsoft 365、Windows 10/11

—

どんな場面で使う？

毎月のシフト表の「枠作り」を自動化して、シフト調整に集中したいとき
スタッフ一覧×日付のマトリックス形式シフト表を短時間で量産したいとき
土日祝の色分けや日ごとの出勤人数集計を自動で付けたいとき
シフト表を月ごとにシートで管理して、過去のシフトも簡単に振り返りたいとき

完成イメージ（Before / After）

Before（手作業）:

毎月、前月のシフト表をコピーして日付を書き換える
曜日を1日ずつ確認して手入力
土日を目視で探して背景色を塗る
スタッフが増減するたびに行を追加・削除
シフトの人数を1列ずつ数える

After（自動化）:

年月を入力してマクロ実行 → カレンダーが自動生成
曜日・土日色分け・祝日マークが自動設定
スタッフ一覧から行が自動生成
シフトパターンに応じた色分けが自動適用
日ごとの人数が自動集計

—

シフト表を毎月手作業で作っていた。31日ある月と30日の月でカレンダーを直し、土日を数えて背景色を塗り、スタッフの行を並べ直す。正直、この「表を作る作業」だけで30分以上かかっていた。肝心のシフト割り当てに入る前に疲れる。VBAで表の生成を自動化してからは、ボタン1つで枠が完成するので、シフトの調整に集中できるようになった。

シフト表の「枠」を作る時間はゼロにできる。考えるべきは中身だけ。

—

実行前の準備

バックアップを取る

マクロ実行前に、Excelファイルのコピーを別フォルダに保存しておく。

Excelをマクロ有効ブック（.xlsm）で保存する

拡張子が .xlsx のままだとマクロが保存できない。

「ファイル」→「名前を付けて保存」
ファイルの種類を「Excelマクロ有効ブック (*.xlsm)」に変更
保存

—

手順（コピペ → 実行まで約5分）

VBE（コードを書く画面）を開く

Excelで Alt + F11 を押す
VBE（Visual Basic Editor）が開く

標準モジュールを挿入する

VBEのメニュー →「挿入」→「標準モジュール」
白い画面（コードウィンドウ）が表示される

コードを貼り付けて実行する

コードウィンドウに、下のコードをそのままコピペする
Alt + F8 → CreateShiftCalendar を選んで「実行」

ボタンに割り当てれば毎回Alt+F8を押さなくて済む。方法はマクロをボタン1つで実行する方法を参照。

—

コード（最小版）– 月のカレンダー＋土日色分け

まずは最小構成で動きを確認する。指定した年月のカレンダーを横方向に生成し、土日を自動で色分けする。


'============================================================
' ■ シフト表のカレンダー自動生成（最小版）
'   → 指定月の日付・曜日を横方向に生成＋土日色分け
'============================================================

Sub CreateShiftCalendar()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    '--- 対象年月を取得 ---
    Dim targetYM As String
    targetYM = InputBox("シフト表を作成する年月を入力してください（例: 2026/04）", _
                        "年月の指定", Format(Date, "yyyy/mm"))
    If targetYM = "" Then Exit Sub

    Dim targetYear As Integer
    Dim targetMonth As Integer
    targetYear = CInt(Left(targetYM, 4))
    targetMonth = CInt(Right(targetYM, 2))

    '--- 月末日を取得 ---
    Dim lastDay As Integer
    lastDay = Day(DateSerial(targetYear, targetMonth + 1, 0))

    '--- ヘッダー行 ---
    ws.Cells(1, 1).Value = targetYear & "年" & targetMonth & "月 シフト表"
    ws.Cells(1, 1).Font.Bold = True
    ws.Cells(1, 1).Font.Size = 14

    '--- 日付行（3行目）と曜日行（4行目）を生成 ---
    '    B列から右へ日付を並べる（A列はスタッフ名用）
    Dim col As Long
    Dim d As Date
    Dim dayNames As Variant
    dayNames = Array("日", "月", "火", "水", "木", "金", "土")

    ws.Cells(3, 1).Value = "日付"
    ws.Cells(4, 1).Value = "曜日"
    ws.Cells(3, 1).Font.Bold = True
    ws.Cells(4, 1).Font.Bold = True

    For col = 1 To lastDay
        d = DateSerial(targetYear, targetMonth, col)

        '--- 日付 ---
        ws.Cells(3, col + 1).Value = col
        ws.Cells(3, col + 1).NumberFormat = "0"
        ws.Cells(3, col + 1).HorizontalAlignment = xlCenter

        '--- 曜日 ---
        ws.Cells(4, col + 1).Value = dayNames(Weekday(d) - 1)
        ws.Cells(4, col + 1).HorizontalAlignment = xlCenter

        '--- 土日の色分け ---
        If Weekday(d) = vbSunday Then
            ws.Cells(3, col + 1).Interior.Color = RGB(255, 200, 200)
            ws.Cells(4, col + 1).Interior.Color = RGB(255, 200, 200)
            ws.Cells(4, col + 1).Font.Color = RGB(200, 0, 0)
        ElseIf Weekday(d) = vbSaturday Then
            ws.Cells(3, col + 1).Interior.Color = RGB(200, 220, 255)
            ws.Cells(4, col + 1).Interior.Color = RGB(200, 220, 255)
            ws.Cells(4, col + 1).Font.Color = RGB(0, 0, 200)
        End If

        '--- 列幅を調整 ---
        ws.Columns(col + 1).ColumnWidth = 4
    Next col

    '--- A列の列幅 ---
    ws.Columns(1).ColumnWidth = 15

    '--- スタッフ名の入力エリア（5行目以降） ---
    ws.Cells(5, 1).Value = "（ここにスタッフ名を入力）"
    ws.Cells(5, 1).Font.Color = RGB(150, 150, 150)

    MsgBox targetYear & "年" & targetMonth & "月のカレンダーを作成しました。" & vbCrLf & _
           "A列の5行目以降にスタッフ名を入力してください。", vbInformation

End Sub

書き換えポイント

変数・箇所	説明	初期値
`ws.Cells(3, col + 1)`	日付行の位置。3行目から開始	3行目
`ws.Cells(4, col + 1)`	曜日行の位置。4行目から開始	4行目
`RGB(255, 200, 200)`	日曜の背景色	薄い赤
`RGB(200, 220, 255)`	土曜の背景色	薄い青
`ColumnWidth = 4`	日付列の幅	4

コードの流れ

InputBox で年月を取得
DateSerial(年, 月+1, 0) で月末日を算出
B列以降に日付（数字）と曜日を横方向に並べる
Weekday で土日を判定し、背景色を設定

月末日の取得に DateSerial を使っている。日付処理の仕組みは日付・曜日の判定で月末処理を自動化で詳しく解説している。色の指定方法はセルの背景色・文字色をRGBで自由に操作する方法を参照。

—

コード（実務版）– スタッフ×日付マトリックス＋シフト色分け＋人数集計＋祝日対応

実務では、スタッフ一覧シートからメンバーを自動取得し、シフトパターンごとの色分けや日ごとの出勤人数集計が欲しくなる。祝日にも対応する。

この実務版を使い始めてからは、「今月のシフト表の枠、できた？」と聞かれる前にもう完成している。枠作りに時間を取られなくなると、シフト調整の質も上がった。

祝日の判定には祝日リストを配列で管理する。営業日計算との組み合わせは祝日・土日を除いた営業日を自動計算する方法も参照。勤怠管理との連携は Excelで勤怠管理表を自動化する方法を確認してほしい。


'============================================================
' ■ シフト表の自動作成（実務版）
'   → スタッフ一覧取得 / カレンダー生成 / シフトパターン色分け
'   → 人数集計行 / 祝日対応
'   → シート構成: シフト表（出力先）, スタッフ（一覧）
'============================================================

'--- 定数 ---
Const SHIFT_SHEET As String = "シフト表"
Const STAFF_SHEET As String = "スタッフ"
Const TITLE_ROW As Long = 1
Const DATE_ROW As Long = 3
Const DOW_ROW As Long = 4        ' 曜日行
Const STAFF_START_ROW As Long = 5 ' スタッフ開始行
Const DATE_START_COL As Long = 2  ' B列から日付開始

'--- シフトパターン定義 ---
' シフト記号と色の対応。実務に合わせて追加・変更する
Const SHIFT_EARLY As String = "早"    ' 早番
Const SHIFT_LATE As String = "遅"     ' 遅番
Const SHIFT_NIGHT As String = "夜"    ' 夜勤
Const SHIFT_OFF As String = "休"      ' 休み
Const SHIFT_PAID As String = "有"     ' 有休

'============================================================
' メイン: シフト表を自動生成する
'============================================================
Sub CreateFullShiftTable()

    '--- シフト表シートがなければ作成 ---
    If Not SheetExists2(SHIFT_SHEET) Then
        ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ActiveSheet.Name = SHIFT_SHEET
    End If

    Dim wsShift As Worksheet
    Set wsShift = ThisWorkbook.Sheets(SHIFT_SHEET)

    '--- 対象年月を取得 ---
    Dim targetYM As String
    targetYM = InputBox("シフト表を作成する年月を入力してください（例: 2026/04）", _
                        "年月の指定", Format(DateSerial(Year(Date), Month(Date) + 1, 1), "yyyy/mm"))
    If targetYM = "" Then Exit Sub

    Dim targetYear As Integer
    Dim targetMonth As Integer
    targetYear = CInt(Left(targetYM, 4))
    targetMonth = CInt(Right(targetYM, 2))

    '--- 月末日を取得 ---
    Dim lastDay As Integer
    lastDay = Day(DateSerial(targetYear, targetMonth + 1, 0))

    '--- スタッフ一覧を取得 ---
    Dim staffList() As String
    Dim staffCount As Long
    staffCount = GetStaffList(staffList)
    If staffCount = 0 Then
        MsgBox "スタッフ一覧が取得できません。" & vbCrLf & _
               "「" & STAFF_SHEET & "」シートのA列にスタッフ名を入力してください。", vbExclamation
        Exit Sub
    End If

    '--- 祝日リストを取得 ---
    Dim holidays() As Date
    Dim holidayCount As Long
    holidayCount = GetHolidays(targetYear, holidays)

    '--- 既存データをクリア ---
    wsShift.Cells.Clear
    wsShift.Cells.Interior.ColorIndex = xlNone

    Application.ScreenUpdating = False

    '--- タイトル ---
    wsShift.Cells(TITLE_ROW, 1).Value = targetYear & "年" & targetMonth & "月 シフト表"
    wsShift.Cells(TITLE_ROW, 1).Font.Bold = True
    wsShift.Cells(TITLE_ROW, 1).Font.Size = 14

    '--- カレンダーヘッダー ---
    wsShift.Cells(DATE_ROW, 1).Value = "スタッフ"
    wsShift.Cells(DATE_ROW, 1).Font.Bold = True
    wsShift.Cells(DOW_ROW, 1).Value = ""

    Dim dayNames As Variant
    dayNames = Array("日", "月", "火", "水", "木", "金", "土")

    Dim col As Long
    Dim d As Date

    For col = 1 To lastDay
        d = DateSerial(targetYear, targetMonth, col)

        '--- 日付行 ---
        wsShift.Cells(DATE_ROW, col + 1).Value = col
        wsShift.Cells(DATE_ROW, col + 1).NumberFormat = "0"
        wsShift.Cells(DATE_ROW, col + 1).HorizontalAlignment = xlCenter
        wsShift.Cells(DATE_ROW, col + 1).Font.Bold = True

        '--- 曜日行 ---
        wsShift.Cells(DOW_ROW, col + 1).Value = dayNames(Weekday(d) - 1)
        wsShift.Cells(DOW_ROW, col + 1).HorizontalAlignment = xlCenter

        '--- 土日・祝日の色分け ---
        Dim bgColor As Long
        Dim ftColor As Long
        bgColor = -1 ' 初期値（色なし）

        If Weekday(d) = vbSunday Or IsHoliday(d, holidays, holidayCount) Then
            bgColor = RGB(255, 200, 200)
            ftColor = RGB(200, 0, 0)
        ElseIf Weekday(d) = vbSaturday Then
            bgColor = RGB(200, 220, 255)
            ftColor = RGB(0, 0, 200)
        End If

        If bgColor <> -1 Then
            '--- ヘッダー行の色 ---
            wsShift.Cells(DATE_ROW, col + 1).Interior.Color = bgColor
            wsShift.Cells(DOW_ROW, col + 1).Interior.Color = bgColor
            wsShift.Cells(DOW_ROW, col + 1).Font.Color = ftColor

            '--- スタッフ行も薄く色付け ---
            Dim r As Long
            For r = STAFF_START_ROW To STAFF_START_ROW + staffCount - 1
                wsShift.Cells(r, col + 1).Interior.Color = bgColor
            Next r
        End If

        '--- 祝日マーク（曜日の下に「祝」を表示） ---
        If IsHoliday(d, holidays, holidayCount) And Weekday(d) <> vbSunday Then
            wsShift.Cells(DOW_ROW, col + 1).Value = dayNames(Weekday(d) - 1) & vbLf & "祝"
            wsShift.Cells(DOW_ROW, col + 1).WrapText = True
        End If

        '--- 列幅 ---
        wsShift.Columns(col + 1).ColumnWidth = 4
    Next col

    '--- スタッフ名を入力 ---
    Dim i As Long
    For i = 0 To staffCount - 1
        wsShift.Cells(STAFF_START_ROW + i, 1).Value = staffList(i)
        wsShift.Cells(STAFF_START_ROW + i, 1).Font.Bold = True
    Next i

    '--- 人数集計行（スタッフの最終行+2） ---
    Dim countRow As Long
    countRow = STAFF_START_ROW + staffCount + 1
    wsShift.Cells(countRow, 1).Value = "出勤人数"
    wsShift.Cells(countRow, 1).Font.Bold = True
    wsShift.Cells(countRow + 1, 1).Value = "早番"
    wsShift.Cells(countRow + 2, 1).Value = "遅番"
    wsShift.Cells(countRow + 3, 1).Value = "夜勤"

    For col = 1 To lastDay
        Dim staffRange As String
        staffRange = GetColLetter(col + 1) & STAFF_START_ROW & ":" & _
                     GetColLetter(col + 1) & (STAFF_START_ROW + staffCount - 1)

        '--- 出勤人数 = 「休」「有」以外のセルをカウント ---
        wsShift.Cells(countRow, col + 1).Formula = _
            "=COUNTA(" & staffRange & ")-COUNTIF(" & staffRange & ",""" & SHIFT_OFF & """)" & _
            "-COUNTIF(" & staffRange & ",""" & SHIFT_PAID & """)"

        '--- シフト別人数 ---
        wsShift.Cells(countRow + 1, col + 1).Formula = _
            "=COUNTIF(" & staffRange & ",""" & SHIFT_EARLY & """)"
        wsShift.Cells(countRow + 2, col + 1).Formula = _
            "=COUNTIF(" & staffRange & ",""" & SHIFT_LATE & """)"
        wsShift.Cells(countRow + 3, col + 1).Formula = _
            "=COUNTIF(" & staffRange & ",""" & SHIFT_NIGHT & """)"

        '--- 集計行のセルを中央揃え ---
        Dim cr As Long
        For cr = countRow To countRow + 3
            wsShift.Cells(cr, col + 1).HorizontalAlignment = xlCenter
        Next cr
    Next col

    '--- A列の幅 ---
    wsShift.Columns(1).ColumnWidth = 15

    '--- 罫線を設定 ---
    Dim dataRange As Range
    Set dataRange = wsShift.Range(wsShift.Cells(DATE_ROW, 1), _
                                  wsShift.Cells(countRow + 3, lastDay + 1))
    With dataRange.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .Color = RGB(180, 180, 180)
    End With

    '--- ヘッダー行の下に太罫線 ---
    wsShift.Range(wsShift.Cells(DOW_ROW, 1), _
                  wsShift.Cells(DOW_ROW, lastDay + 1)).Borders(xlEdgeBottom).Weight = xlMedium

    '--- 集計行の上に太罫線 ---
    wsShift.Range(wsShift.Cells(countRow, 1), _
                  wsShift.Cells(countRow, lastDay + 1)).Borders(xlEdgeTop).Weight = xlMedium

    '--- 凡例を表示 ---
    Dim legendRow As Long
    legendRow = countRow + 5
    wsShift.Cells(legendRow, 1).Value = "【凡例】"
    wsShift.Cells(legendRow, 1).Font.Bold = True
    wsShift.Cells(legendRow + 1, 1).Value = SHIFT_EARLY & ": 早番"
    wsShift.Cells(legendRow + 1, 1).Interior.Color = RGB(255, 255, 200)
    wsShift.Cells(legendRow + 2, 1).Value = SHIFT_LATE & ": 遅番"
    wsShift.Cells(legendRow + 2, 1).Interior.Color = RGB(200, 255, 200)
    wsShift.Cells(legendRow + 3, 1).Value = SHIFT_NIGHT & ": 夜勤"
    wsShift.Cells(legendRow + 3, 1).Interior.Color = RGB(220, 200, 255)
    wsShift.Cells(legendRow + 4, 1).Value = SHIFT_OFF & ": 休み"
    wsShift.Cells(legendRow + 4, 1).Interior.Color = RGB(220, 220, 220)
    wsShift.Cells(legendRow + 5, 1).Value = SHIFT_PAID & ": 有休"
    wsShift.Cells(legendRow + 5, 1).Interior.Color = RGB(255, 220, 200)

    Application.ScreenUpdating = True

    wsShift.Activate
    wsShift.Cells(STAFF_START_ROW, 2).Select

    MsgBox targetYear & "年" & targetMonth & "月のシフト表を作成しました。" & vbCrLf & _
           "スタッフ: " & staffCount & "名" & vbCrLf & _
           "各セルにシフト記号（早/遅/夜/休/有）を入力してください。", vbInformation

End Sub

'============================================================
' シフト記号に応じてセルを色分けする
'   → シフト入力後に実行して色を一括適用する
'============================================================
Sub ColorShiftCells()

    Dim wsShift As Worksheet
    If Not SheetExists2(SHIFT_SHEET) Then
        MsgBox "シフト表シートがありません。先にシフト表を作成してください。", vbExclamation
        Exit Sub
    End If
    Set wsShift = ThisWorkbook.Sheets(SHIFT_SHEET)

    '--- スタッフ範囲を特定 ---
    Dim lastRow As Long
    lastRow = wsShift.Cells(wsShift.Rows.Count, 1).End(xlUp).Row

    Dim lastCol As Long
    lastCol = wsShift.Cells(DATE_ROW, wsShift.Columns.Count).End(xlToLeft).Column

    Application.ScreenUpdating = False

    Dim r As Long, c As Long
    For r = STAFF_START_ROW To lastRow
        '--- 集計行以降はスキップ ---
        If wsShift.Cells(r, 1).Value = "出勤人数" Then Exit For

        For c = DATE_START_COL To lastCol
            Dim cellVal As String
            cellVal = Trim(wsShift.Cells(r, c).Value)

            '--- 土日の背景色は維持するためスキップ ---
            If cellVal = "" Then GoTo NextCell

            Select Case cellVal
                Case SHIFT_EARLY
                    wsShift.Cells(r, c).Interior.Color = RGB(255, 255, 200) ' 薄い黄
                Case SHIFT_LATE
                    wsShift.Cells(r, c).Interior.Color = RGB(200, 255, 200) ' 薄い緑
                Case SHIFT_NIGHT
                    wsShift.Cells(r, c).Interior.Color = RGB(220, 200, 255) ' 薄い紫
                Case SHIFT_OFF
                    wsShift.Cells(r, c).Interior.Color = RGB(220, 220, 220) ' グレー
                Case SHIFT_PAID
                    wsShift.Cells(r, c).Interior.Color = RGB(255, 220, 200) ' 薄いオレンジ
            End Select

            wsShift.Cells(r, c).HorizontalAlignment = xlCenter
NextCell:
        Next c
    Next r

    Application.ScreenUpdating = True
    MsgBox "シフトの色分けを適用しました。", vbInformation

End Sub

'============================================================
' スタッフ一覧を取得する（ヘルパー関数）
'   → 「スタッフ」シートのA列からスタッフ名を読み取る
'============================================================
Private Function GetStaffList(ByRef staffList() As String) As Long

    If Not SheetExists2(STAFF_SHEET) Then
        GetStaffList = 0
        Exit Function
    End If

    Dim wsStaff As Worksheet
    Set wsStaff = ThisWorkbook.Sheets(STAFF_SHEET)

    Dim lastRow As Long
    lastRow = wsStaff.Cells(wsStaff.Rows.Count, "A").End(xlUp).Row

    '--- ヘッダー行をスキップ（A1が「スタッフ名」等の場合） ---
    Dim startRow As Long
    If IsNumeric(wsStaff.Range("A1").Value) Or wsStaff.Range("A1").Value = "" Then
        startRow = 1
    Else
        startRow = 2
    End If

    If lastRow < startRow Then
        GetStaffList = 0
        Exit Function
    End If

    Dim cnt As Long
    cnt = lastRow - startRow + 1
    ReDim staffList(0 To cnt - 1)

    Dim i As Long
    For i = 0 To cnt - 1
        staffList(i) = wsStaff.Cells(startRow + i, "A").Value
    Next i

    GetStaffList = cnt

End Function

'============================================================
' 祝日リストを取得する（ヘルパー関数）
'   → 対象年の祝日を配列で返す
'   → 祝日の追加・変更はこの関数内を修正する
'============================================================
Private Function GetHolidays(ByVal targetYear As Integer, _
                              ByRef holidays() As Date) As Long

    '--- 主要な祝日（固定日のみ。振替休日・春分・秋分は手動追加が必要） ---
    Dim tmpHolidays(0 To 15) As Date
    Dim cnt As Long
    cnt = 0

    ' 元日
    tmpHolidays(cnt) = DateSerial(targetYear, 1, 1): cnt = cnt + 1
    ' 成人の日（1月の第2月曜日）
    tmpHolidays(cnt) = GetNthWeekday(targetYear, 1, vbMonday, 2): cnt = cnt + 1
    ' 建国記念の日
    tmpHolidays(cnt) = DateSerial(targetYear, 2, 11): cnt = cnt + 1
    ' 天皇誕生日
    tmpHolidays(cnt) = DateSerial(targetYear, 2, 23): cnt = cnt + 1
    ' 春分の日（概算: 3/20 or 3/21。正確には国立天文台の計算が必要）
    tmpHolidays(cnt) = DateSerial(targetYear, 3, 20): cnt = cnt + 1
    ' 昭和の日
    tmpHolidays(cnt) = DateSerial(targetYear, 4, 29): cnt = cnt + 1
    ' 憲法記念日
    tmpHolidays(cnt) = DateSerial(targetYear, 5, 3): cnt = cnt + 1
    ' みどりの日
    tmpHolidays(cnt) = DateSerial(targetYear, 5, 4): cnt = cnt + 1
    ' こどもの日
    tmpHolidays(cnt) = DateSerial(targetYear, 5, 5): cnt = cnt + 1
    ' 海の日（7月の第3月曜日）
    tmpHolidays(cnt) = GetNthWeekday(targetYear, 7, vbMonday, 3): cnt = cnt + 1
    ' 山の日
    tmpHolidays(cnt) = DateSerial(targetYear, 8, 11): cnt = cnt + 1
    ' 敬老の日（9月の第3月曜日）
    tmpHolidays(cnt) = GetNthWeekday(targetYear, 9, vbMonday, 3): cnt = cnt + 1
    ' 秋分の日（概算: 9/22 or 9/23）
    tmpHolidays(cnt) = DateSerial(targetYear, 9, 23): cnt = cnt + 1
    ' スポーツの日（10月の第2月曜日）
    tmpHolidays(cnt) = GetNthWeekday(targetYear, 10, vbMonday, 2): cnt = cnt + 1
    ' 文化の日
    tmpHolidays(cnt) = DateSerial(targetYear, 11, 3): cnt = cnt + 1
    ' 勤労感謝の日
    tmpHolidays(cnt) = DateSerial(targetYear, 11, 23): cnt = cnt + 1

    ReDim holidays(0 To cnt - 1)
    Dim i As Long
    For i = 0 To cnt - 1
        holidays(i) = tmpHolidays(i)
    Next i

    GetHolidays = cnt

End Function

'============================================================
' 第N週の特定曜日の日付を取得する（ヘルパー関数）
'   → 例: 2026年1月の第2月曜日
'============================================================
Private Function GetNthWeekday(ByVal y As Integer, ByVal m As Integer, _
                                ByVal dow As VbDayOfWeek, ByVal n As Integer) As Date
    Dim firstDay As Date
    firstDay = DateSerial(y, m, 1)

    Dim offset As Long
    offset = (dow - Weekday(firstDay) + 7) Mod 7
    GetNthWeekday = firstDay + offset + (n - 1) * 7

End Function

'============================================================
' 祝日判定（ヘルパー関数）
'============================================================
Private Function IsHoliday(ByVal d As Date, ByRef holidays() As Date, _
                            ByVal holidayCount As Long) As Boolean
    Dim i As Long
    For i = 0 To holidayCount - 1
        If d = holidays(i) Then
            IsHoliday = True
            Exit Function
        End If
    Next i
    IsHoliday = False
End Function

'============================================================
' 列番号→列文字変換（ヘルパー関数）
'============================================================
Private Function GetColLetter(ByVal colNum As Long) As String
    Dim colAddr As String
    colAddr = Cells(1, colNum).Address(False, False)
    GetColLetter = Replace(colAddr, "1", "")
End Function

'============================================================
' シートの存在チェック（ヘルパー関数）
'============================================================
Private Function SheetExists2(ByVal targetName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(targetName)
    On Error GoTo 0
    SheetExists2 = Not ws Is Nothing
End Function

シートの準備（実務版）

「スタッフ」シート — A列にスタッフ名を入力する

A列
スタッフ名
田中太郎
佐藤花子
鈴木一郎
山田美咲
高橋健二

A1がヘッダー（「スタッフ名」等の文字列）ならA2から読み取り、数値やブランクならA1から読み取る。

書き換えポイント

変数・箇所	説明	初期値
`SHIFT_SHEET`	シフト表の出力先シート名	`"シフト表"`
`STAFF_SHEET`	スタッフ一覧のシート名	`"スタッフ"`
`SHIFT_EARLY` 等	シフト記号。自社のシフト体系に合わせて変更	早/遅/夜/休/有
`RGB(255, 255, 200)` 等	各シフトの色。好みに合わせて変更	黄/緑/紫/グレー/オレンジ
`GetHolidays` 内の日付	祝日リスト。振替休日や特別休日は手動追加	2026年の主要祝日

コードの流れ

CreateFullShiftTable: スタッフ一覧を読み取り、カレンダーを横方向に生成。土日・祝日を色分けし、人数集計行にCOUNTIF数式を自動設定
ColorShiftCells: シフト記号（早/遅/夜/休/有）が入力されたセルを色分け。シフト入力後に実行する
GetStaffList: 「スタッフ」シートからスタッフ名を配列で取得
GetHolidays: 対象年の祝日一覧を配列で返す
GetNthWeekday: 第N週の特定曜日を算出（成人の日、海の日など）

人数集計行には COUNTIF 数式を埋め込んでいるため、シフト記号を入力するだけでリアルタイムに人数が更新される。

—

落とし穴

#	症状	原因	対策
1	祝日が色分けされない	`GetHolidays` に該当する祝日が登録されていない。春分の日・秋分の日は年によって日付が変わる	毎年、内閣府の「国民の祝日」を確認して `GetHolidays` を更新する。振替休日も手動で追加が必要
2	列が足りない（12月の31日目がはみ出す）	B列から始めているため、31日分だとAF列まで使う。表示範囲から見切れるだけで、データは正常	ウィンドウ枠を固定してA列を常に表示する。`FreezePanes` の使い方はウィンドウ枠の固定・解除をVBAで自動化する方法を参照
3	COUNTIF の集計が合わない	セルにスペースが入っている。「早」（後ろに空白）は「早」と別物として扱われる	`Trim` で空白を除去するか、入力規則でドロップダウンリストを設定して入力ミスを防ぐ
4	色分けマクロを実行しても色が変わらない	`ColorShiftCells` はスタッフ行を上から走査するが、「出勤人数」行が見つからずスキップされている	A列に「出勤人数」と正確に入力されているか確認する。文字が違うとループ終了条件に引っかからない
5	2月のシフト表で32行目以降にゴミデータが残る	前月のシフト表を同じシートに上書きした際、前月のデータが残っている	コード内で `Cells.Clear` を実行しているため、実務版なら問題ない。最小版を使う場合は手動でクリアする
6	シフト表の印刷がA4に収まらない	31列+A列で横幅が広く、通常の印刷設定では収まらない。自分も最初これに気づかず、何度も印刷し直した	`PageSetup.Orientation = xlLandscape`（横向き）にし、`PageSetup.Zoom = 60` 程度に縮小する。印刷設定の一括変更は複数シートの印刷設定を一括変更して印刷する方法を参照

VBAでシフト表の色分けが反映されないときの対処法

「マクロを実行したのにセルの色が変わらない」場合、A列の「出勤人数」行が見つからずループ終了条件に引っかかっていない可能性が高い。A列に「出勤人数」と正確に入力されているか確認しよう。文字が1文字でも違うとスキップされるので、コピペで入力するのが確実だ。

VBAでシフト表のCOUNTIF集計が合わないときの対処法

「出勤人数の合計がおかしい」場合、セル内のシフト記号に余分なスペースが入っていることが原因だ。「早」（後ろに空白付き）と「早」は別の文字列として扱われる。入力規則でドロップダウンリストを設定してシフト記号を選択式にするか、マクロ内でTrim関数を使ってスペースを除去しよう。

—

FAQ

Q1. シフトパターンを増やしたい（例: 「半」= 半日勤務）場合は？

定数を追加し、ColorShiftCells の Select Case に1ケース追加すればよい。例:


Const SHIFT_HALF As String = "半"

' Select Case 内に追加
Case SHIFT_HALF
    wsShift.Cells(r, c).Interior.Color = RGB(200, 255, 255) ' 薄い水色

人数集計行にも COUNTIF を1行追加する。

Q2. シフト入力のたびに自動で色分けされるようにしたい

Worksheet_Change イベントを使えば、セルの値が変わったタイミングで自動色分けできる。イベント処理の仕組みはセルの値が変わったら自動実行（Worksheet_Change）を参照。ただし、大量セルを一度に変更すると処理が重くなるため、EnableEvents = False で制御すること。

Q3. スタッフごとの月間出勤日数を集計するには？

シフト表の右端に集計列を追加する。例えばAG列（33列目）に以下のような数式を入れる:


' スタッフ行の右端に出勤日数を表示する処理を追加する場合
wsShift.Cells(STAFF_START_ROW + i, lastDay + 2).Formula = _
    "=COUNTA(" & GetColLetter(DATE_START_COL) & STAFF_START_ROW + i & ":" & _
    GetColLetter(lastDay + 1) & STAFF_START_ROW + i & ")" & _
    "-COUNTIF(" & GetColLetter(DATE_START_COL) & STAFF_START_ROW + i & ":" & _
    GetColLetter(lastDay + 1) & STAFF_START_ROW + i & ",""休"")" & _
    "-COUNTIF(" & GetColLetter(DATE_START_COL) & STAFF_START_ROW + i & ":" & _
    GetColLetter(lastDay + 1) & STAFF_START_ROW + i & ",""有"")"

Q4. 祝日リストをシートで管理したい

GetHolidays をコード内のハードコーディングではなく、「祝日」シートのA列から読み取るように変更すればよい。毎年の更新がシート上で完結するため、コードを触る必要がなくなる。自分はこの方法に切り替えてから、年末の祝日更新作業がだいぶ楽になった。

—