【Excel VBA】シフト表自動作成マクロをカスタマイズしやすくしました

これまで3回に渡って改良してきた勤務表自動作成ツールですが、今回の記事で完全版としたいと考えています。

前回の記事は二次元配列を使うことで高速化したというのがメインでしたが、それ以外に夜勤の労働数や遅出の翌日は早出禁止といった条件をセルの値を変えることで切り替えられる仕様にしていました。

これは考えうるニーズのある機能を埋め込んでおいて、ユーザーが任意で使うか使わないかを簡単に切り替えられるというユーザー目線の仕様でした。

ただ、多機能にしようと思えばいくらでもできてしまうのでキリがありません。多機能にすると操作や設定が複雑になって使いにくいものになってしまいます。

それでも使用するユーザーが多いのであれば、知識のないユーザーが自由に設定を切り替えられるのは便利です。逆に使用するユーザーが限定されるのであれば、機能を最低限にして開発者が特定のユーザー向けにカスタマイズする方が合理的だと考えました。

というわけで、この完全版では開発者が任意でカスタマイズしやすいようにコードを整理しました。

追記: 完全版と言いながらさらなる改良版を作りました。

スポンサーリンク

プログラムの内容

こちらがサンプルデータです。

https://www.iehohs.com/files/excel-auto-shift4.zip

勤務表本体部分と、下に日別の集計、右側に人別の集計、さらにその右に自動作成用の設定があります。

勤務表は入力規則によってドロップダウンで選択できるようにしています。

集計は1列・行目の文字列をCOUNTIFで数え、2列・行目の数字未満であれば赤くハイライトするよう条件付き書式を設定しています。

なお、前回まで選択しているセルの職員と日付がハイライトされるようにしていましたが、動作が重たくなるので今回は設定していません。

新規シート作成

[新規]ボタンを押すと年月を入力するフォームが出てきます。選択式にすることで分岐を減らせますし、何よりユーザーの入力が楽になります。

西暦は現在の年と前後1年を選択できるようにしています。

この西暦と月から1ヶ月の日数と曜日を取得して自動的に設定し、新規シートを作成します。

実際には[新規]ボタンを押した時のアクティブシートを複製して、勤務表の中身をクリアして日付と曜日を設定し直しているだけです。

職員追加

[追加]ボタンを押すと職員名を入力するウィンドウが出てきます。

これで勤務表の最終行に追加されます。

これだけなら行追加でやってもそれほど労力はかからないのですが、その場合の問題は下の集計です。

単に行追加しただけではCOUNTIFの数式の参照が変わらず、追加した行が集計されません。このボタンから追加を行うことで、中の数式も更新しています。

自動入力

肝となる部分です。事前準備として、希望休や勤務の予定が決まっていればあらかじめ入力しておきます。

自動入力はランダムでセルを選択し、空白セルに対して入力していきます。何かしらの値が入っているセルは対象外になります。

そして設定の部分ですが、夜・公休・早・遅の4つのシフトを入力します。この並びで順番に処理が行われます。

それぞれの要件は以下の通りです。

1労働の夜勤で、基本的に連続夜勤でその後は連続休み。
連続にならなかった場合は翌日休み。
公休月によって日数が変化。31日の月は10日、28日の月は8日、それ以外は9日。
5連勤以上にならないようにする。
遅出の次の日は早出にならないようにする。
早出の前日は遅出にならないようにする。

1行目の文字列が入力され、2行目は設定する回数です。夜・早・遅は1日あたりの人数で、公休は1ヶ月あたりの回数です。公休については勤務表の日付の入力から自動的に値が変わるように関数を埋め込んでいます。

今回の設定では夜勤は1人、早出と遅出が2人ずつ、6月は30日までなので公休は9日設定されます。

各職員の行は自動入力するか否かを設定でき、0ならオフ、1ならオンです。公休は1なら常勤、0なら非常勤とみなされます。

設定が確認できたら[入力]ボタンを押します。

二次元配列内で処理をして最後にシートへ貼り付けているのでほとんど時間がかからず完了します。セルの背景色はあらかじめ条件付き書式で設定されています。

設定通り入力されますが、職員数が少なかったりあらかじめ入力されていた予定が多いと設定の人数や回数に満たない場合もあります。集計で数が合っているか確認します。

空白置換

自動入力後の調整は自由です。ここでめんどくさいのは空白セルの処置。1つずつ埋めるのは大変です。

[置換]ボタンを押すと、常勤職員は「日」、非常勤職員は「休」が空白セルに入ります。常勤と非常勤の判定は公休の列で行います。

これで勤務表の完成という流れです。

コード

VBA – Module1(標準モジュール)

Dim headRow As Integer          '先頭行
Dim headCol As Integer          '先頭列
Dim rowStart As Integer         '1人目行番号
Dim colStart As Integer         '1日目列番号
Dim rowEnd As Integer           '勤務表最終行
Dim shukeiRowStart As Integer   '日別集計開始行
Dim shukeiRowEnd As Integer     '日別集計最終行
Dim colEnd As Integer           '勤務表最終列
Dim shukeiColStart As Integer   '人別集計開始列
Dim shukeiColEnd As Integer     '人別集計最終列
Dim setteiColStart As Integer   '設定開始列
Dim setteiColEnd As Integer     '設定最終列
Dim kinmuTable() As String      '勤務表テーブル
Dim fullCnt As Integer          '指定回数
Dim setStr As String            '入力文字列
Public flg As Boolean           'フォーム用フラグ
Private Sub レイアウト設定()
    headRow = 1     '先頭行
    headCol = 1     '先頭列
    rowStart = 3    '1人目行番号
    colStart = 3    '1日目列番号
    '勤務表最終行
    i = headRow
    Do While Cells(i, headCol).Value <> ""
        i = i + 1
    Loop
    rowEnd = i - 1
    '日別集計開始行
    Do While Cells(i, headCol).Value = ""
        i = i + 1
    Loop
    shukeiRowStart = i + 1
    '日別集計最終行
    Do While Cells(i, headCol).Value <> ""
        i = i + 1
    Loop
    shukeiRowEnd = i - 1
    '勤務表最終列
    i = headCol
    Do While Cells(headRow, i).Value <> ""
        i = i + 1
    Loop
    colEnd = i - 1
    '人別集計開始列
    Do While Cells(headRow, i).Value = ""
        i = i + 1
    Loop
    shukeiColStart = i
    '人別集計最終列
    Do While Cells(headRow, i).Value <> ""
        i = i + 1
    Loop
    shukeiColEnd = i - 1
    '設定開始列
    Do While Cells(headRow, i) = ""
        i = i + 1
    Loop
    setteiColStart = i
    '設定最終列
    Do While Cells(headRow, i).Value <> ""
        i = i + 1
    Loop
    setteiColEnd = i - 1
End Sub
Sub 自動入力()
    Call レイアウト設定
    Dim thisSheetName As String     '実行時アクティブなシート名
    Dim setteiTable() As Integer    '設定情報テーブル
    Dim haichiTable() As Variant    '配置情報テーブル
    Dim rowArray() As Integer       '行番号シャッフル用配列
    Dim colArray() As Integer       '列番号シャッフル用配列
    Dim rowArrayCnt As Integer      '行番号シャッフル用カウンタ
    Dim colArrayCnt As Integer      '列番号シャッフル用カウンタ
    Dim setFlg As Boolean           '入力フラグ
    Dim setCnt As Integer           '入力回数
    Dim setCnt2 As Integer          '入力回数(連続夜勤用)
    Dim fullCnt As Integer          '指定回数
    Dim renkinJougen As Integer     '連勤上限
    Dim koukyuAverage As Integer    '1日あたり平均公休日数
    Dim koukyuStr As String         '公休
    Dim yasumiStr As String         '休
    Dim holiStr As String           'HOLI(希望休との区別用)
    Dim beforeFlg As Boolean        '連勤チェック前日フラグ
    Dim afterFlg As Boolean         '連勤チェック後日フラグ
    Dim r As Integer                '行番号
    Dim c As Integer                '列番号
    '勤務表をテーブルに、シャッフル用列番号を配列に格納
    ReDim kinmuTable(rowEnd - rowStart, colEnd - colStart)
    ReDim colArray(colEnd - colStart)
    For c = 0 To UBound(kinmuTable, 2)
        colArray(c) = c
        For r = 0 To UBound(kinmuTable, 1)
            kinmuTable(r, c) = Cells(rowStart + r, colStart + c).Value
        Next r
    Next c
    '設定と配置情報をテーブルに格納
    ReDim setteiTable(rowEnd - rowStart, setteiColEnd - setteiColStart)
    ReDim haichiTable(1, UBound(setteiTable, 2))
    For c = 0 To UBound(setteiTable, 2)
        haichiTable(0, c) = Cells(headRow, setteiColStart + c).Value
        haichiTable(1, c) = Cells(headRow + 1, setteiColStart + c).Value
        For r = 0 To UBound(setteiTable, 1)
            setteiTable(r, c) = Cells(rowStart + r, setteiColStart + c).Value
        Next r
    Next c
    '自動入力開始
    For i = 0 To UBound(haichiTable, 2)
        'シャッフル用行番号を設定に従いセット
        rowArrayCnt = 0
        ReDim rowArray(rowArrayCnt)
        For r = 0 To UBound(setteiTable, 1)
            If setteiTable(r, i) = 1 Then
                ReDim Preserve rowArray(rowArrayCnt)
                rowArray(rowArrayCnt) = r
                rowArrayCnt = rowArrayCnt + 1
            End If
        Next r
        'シャッフルしカウンタをリセット
        Call シャッフル(rowArray())
        rowArrayCnt = 0
        '配置情報が0でなければ入力
        If haichiTable(1, i) > 0 Then
            Select Case i
                Case 0  '夜勤
                    setStr = haichiTable(0, i)      '夜
                    koukyuStr = haichiTable(0, 1)   '公休
                    fullCnt = haichiTable(1, i)     '回数
                    yasumiStr = "休"
                    '各列を走査
                    For c = 0 To UBound(kinmuTable, 2)
                        setCnt = 0
                        shuffleFlg = False
                        Call 人数カウント(setCnt, setStr, c)
                        '指定回数に至るまで入力
                        Do While setCnt < fullCnt
                            r = rowArray(rowArrayCnt)   'シャッフルされた行番号を取得
                            If kinmuTable(r, c) = "" Then   '空白であれば処理開始
                                '翌日を確認してからセット
                                setFlg = False
                                If c = UBound(kinmuTable, 2) Then       '最終列ならセット
                                    setFlg = True
                                ElseIf kinmuTable(r, c + 1) = "" Then   '翌日が空白ならセット
                                    setFlg = True
                                End If
                                If setFlg = True Then
                                    kinmuTable(r, c) = setStr
                                    setCnt = setCnt + 1
                                    '連続処理
                                    If c <> UBound(kinmuTable, 2) Then
                                        setCnt2 = 0     '翌日の人数カウント
                                        Call 人数カウント(setCnt2, setStr, c + 1)
                                        If setCnt2 < fullCnt Then
                                            '休みの文字列
                                            Select Case setteiTable(r, 1)
                                                Case 1      '常勤なら「公休」
                                                    holidayStr = koukyuStr
                                                Case 0      '非常勤なら「休」
                                                    holidayStr = yasumiStr
                                            End Select
                                            setFlg = False
                                            If c + 1 = UBound(kinmuTable, 2) Then       '翌日が最終列ならセット
                                                setFlg = True
                                            ElseIf kinmuTable(r, c + 2) = "" Then       '翌々日が空白なら
                                                If c + 2 = UBound(kinmuTable, 2) Then   '且つ翌々日が最終列ならセット
                                                    setFlg = True
                                                Else
                                                    Select Case kinmuTable(r, c + 3)    '且つ3日後が空白か休みならセット
                                                        Case "", holidayStr
                                                            setFlg = True
                                                    End Select
                                                End If
                                            End If
                                        End If
                                        If setFlg = True Then       '連続夜勤後、連休
                                            kinmuTable(r, c + 1) = setStr
                                            If c + 1 <> UBound(kinmuTable, 2) Then      '翌日が最終列でなければ
                                                kinmuTable(r, c + 2) = holidayStr
                                                If c + 2 <> UBound(kinmuTable, 2) Then  '翌々日が最終列でなければ
                                                    kinmuTable(r, c + 3) = holidayStr
                                                End If
                                            End If
                                        Else                        '連続でない場合、翌日は休み
                                            kinmuTable(r, c + 1) = holidayStr
                                        End If
                                    End If
                                End If
                            End If
                            'シャッフル用カウンタ処理
                            If rowArrayCnt = UBound(rowArray()) Then    'カウンタが最後まで到達したら再シャッフル
                                If shuffleFlg = False Then  'シャッフルが1回目ならば
                                    Call シャッフル(rowArray())
                                    rowArrayCnt = 0
                                    shuffleFlg = True       'シャッフルを実行したらフラグを立てる
                                Else                        'シャッフルが2回目ならば次の列へ進む
                                    setCnt = fullCnt
                                End If
                            Else    'カウンタを増やす
                                rowArrayCnt = rowArrayCnt + 1
                            End If
                        Loop
                    Next c
                Case 1  '公休
                    koukyuStr = haichiTable(0, i)
                    yasumiStr = "休"
                    holiStr = "HOLI"    '希望休との区別用文字列
                    '1日あたり平均公休日数を指定回数にする
                    koukyuAve = Round((haichiTable(1, i) * UBound(rowArray) + 1) / UBound(kinmuTable, 2), 0)
                    fullCnt = koukyuAve
                    '各列を走査
                    For c = 0 To UBound(kinmuTable, 2)
                        shuffleFlg = False
                        setCnt = 0
                        Call 人数カウント(setCnt, koukyuStr, c)
                        Do While setCnt < fullCnt
                            r = rowArray(rowArrayCnt)
                            If kinmuTable(r, c) = "" Then
                                kinmuTable(r, c) = holiStr
                                setCnt = setCnt + 1
                            End If
                            If rowArrayCnt = UBound(rowArray) Then
                                Call シャッフル(rowArray())
                                rowArrayCnt = 0
                                Select Case shuffleFlg
                                    Case False
                                        shuffleFlg = True
                                    Case True
                                        setCnt = fullCnt
                                End Select
                            Else
                                rowArrayCnt = rowArrayCnt + 1
                            End If
                        Loop
                    Next c
                    '公休日数と連勤をチェック
                    fullCnt = haichiTable(1, i)     '1ヶ月の公休日数を指定回数にする
                    renkinJougen = 5                '連勤上限
                    '1人ずつ公休日数を数える
                    For j = 0 To UBound(rowArray)
                        r = rowArray(j)
                        setCnt = 0
                        renkinCnt = 0
                        For c = 0 To UBound(kinmuTable, 2)
                            Select Case kinmuTable(r, c)
                                Case koukyuStr, holiStr     '公休 or HOLIであればカウントし、連勤カウントをリセット
                                    setCnt = setCnt + 1
                                    renkinCnt = 0
                                Case Else
                                    renkinCnt = renkinCnt + 1
                                    '連勤カウントが上限を超えた場合
                                    If renkinCnt = renkinJougen + 1 Then
                                        n = c   '現在処理中の列番号をnに格納
                                        '1日ずつ遡り、最初の空欄にHOLIをセット
                                        Do While renkinCnt > 0  '空欄がなければ元の列番号から走査再開
                                            Select Case kinmuTable(r, n)
                                                Case ""
                                                    kinmuTable(r, n) = holiStr
                                                    setCnt = setCnt + 1
                                                    c = n   'セットした列から走査し直し
                                                    renkinCnt = 0
                                                Case Else
                                                    If n = 0 Then
                                                        renkinCnt = 0
                                                    Else
                                                        renkinCnt = renkinCnt - 1
                                                        n = n - 1
                                                    End If
                                            End Select
                                        Loop
                                    End If
                            End Select
                        Next c
                        '公休日数が足りない場合
                        If setCnt < fullCnt Then
                            Call シャッフル(colArray())     '列番号シャッフル
                            For k = 0 To UBound(colArray)
                                c = colArray(k)     'シャッフルした列番号を取得
                                If kinmuTable(r, c) = "" Then   '空欄であればセット
                                    kinmuTable(r, c) = holiStr
                                    setCnt = setCnt + 1
                                    If setCnt = fullCnt Then
                                        Exit For
                                    End If
                                End If
                            Next k
                        End If
                        '公休日数がオーバーしている場合
                        If setCnt > fullCnt Then
                            Call シャッフル(colArray())
                            For k = 0 To UBound(colArray)
                                c = colArray(k)
                                'HOLIであれば連勤状況確認後に消去
                                If kinmuTable(r, c) = holiStr Then
                                    renkinCnt = 1
                                    n = 1   '対象列からの距離
                                    beforeFlg = False   '前日フラグ
                                    afterFlg = False    '後日フラグ
                                    '前後の勤務を見て、削除した場合に連勤カウントが上限に達しないかチェック
                                    Do While renkinCnt <= renkinJougen
                                        Select Case beforeFlg
                                            Case False      '前日をチェック
                                                If c - n >= 0 Then
                                                    Select Case kinmuTable(r, c - n)
                                                        Case koukyuStr, holiStr     '公休 or HOLIなら前日フラグを立てて後日へ
                                                            beforeFlg = True
                                                            n = 1
                                                        Case Else
                                                            n = n + 1
                                                            renkinCnt = renkinCnt + 1
                                                    End Select
                                                Else        '先頭列まで来たら後日へ移る
                                                    beforeFlg = True
                                                    n = 1
                                                End If
                                            Case True       '後日をチェック
                                                If c + n <= UBound(kinmuTable, 2) Then
                                                    Select Case kinmuTable(r, c + n)
                                                        Case koukyuStr, holiStr     '公休 or HOLIなら後日フラグを立てる
                                                            afterFlg = True
                                                        Case Else
                                                            renkinCnt = renkinCnt + 1
                                                            n = n + 1
                                                    End Select
                                                Else        '最終列まで来たら削除OK
                                                    afterFlg = True
                                                End If
                                        End Select
                                        If afterFlg = True Then     '後日フラグが立っていれば削除OK
                                            kinmuTable(r, c) = ""
                                            setCnt = setCnt - 1
                                            Exit Do
                                        End If
                                    Loop
                                End If
                                If setCnt = fullCnt Then
                                    Exit For
                                End If
                            Next k
                        End If
                    Next j
                    'HOLIを公休に置換
                    For r = 0 To UBound(kinmuTable, 1)
                        For c = 0 To UBound(kinmuTable, 2)
                            If kinmuTable(r, c) = holiStr Then
                                kinmuTable(r, c) = koukyuStr
                            End If
                        Next c
                    Next r
                Case 2  '早
                    setStr = haichiTable(0, i)
                    fullCnt = haichiTable(1, i)
                    For c = 0 To UBound(kinmuTable, 2)
                        setCnt = 0
                        Call 人数カウント(setStr, setCnt, c)
                        shuffleFlg = False
                        Do While setCnt < fullCnt
                            r = rowArray(rowArrayCnt)
                            If kinmuTable(r, c) = "" Then
                                setFlg = False
                                Select Case c
                                    Case 0
                                        setFlg = True
                                    Case Else   '前日が「遅」の場合は入力しない
                                        If Not kinmuTable(r, c - 1) Like haichiTable(0, 3) Then
                                            setFlg = True
                                        End If
                                End Select
                                If setFlg = True Then
                                    kinmuTable(r, c) = setStr
                                    setCnt = setCnt + 1
                                End If
                            End If
                            If rowArrayCnt = UBound(rowArray) Then
                                Call シャッフル(rowArray())
                                rowArrayCnt = 0
                                Select Case shuffleFlg
                                    Case False
                                        shuffleFlg = True
                                    Case True
                                        setCnt = fullCnt
                                End Select
                            Else
                                rowArrayCnt = rowArrayCnt + 1
                            End If
                        Loop
                    Next c
                Case 3  '遅
                    setStr = haichiTable(0, i)
                    fullCnt = haichiTable(1, i)
                    For c = 0 To UBound(kinmuTable, 2)
                        setCnt = 0
                        Call 人数カウント(setStr, setCnt, c)
                        shuffleFlg = False
                        Do While setCnt < fullCnt
                            r = rowArray(rowArrayCnt)
                            If kinmuTable(r, c) = "" Then
                                setFlg = False
                                Select Case c
                                    Case UBound(kinmuTable, 2)
                                        setFlg = True
                                    Case Else   '翌日が「早」の場合は入力しない
                                        If Not kinmuTable(r, c + 1) Like haichiTable(0, 2) Then
                                            setFlg = True
                                        End If
                                End Select
                                If setFlg = True Then
                                    kinmuTable(r, c) = setStr
                                    setCnt = setCnt + 1
                                End If
                            End If
                            If rowArrayCnt = UBound(rowArray) Then
                                Call シャッフル(rowArray())
                                rowArrayCnt = 0
                                Select Case shuffleFlg
                                    Case False
                                        shuffleFlg = True
                                    Case True
                                        setCnt = fullCnt
                                End Select
                            Else
                                rowArrayCnt = rowArrayCnt + 1
                            End If
                        Loop
                    Next c
            End Select
        End If
    Next i
    'シートを複製
    thisSheetName = ActiveSheet.Name
    Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)
    ActiveSheet.Name = thisSheetName & "入力済"
    'テーブルを勤務表に貼り付け
    Range(Cells(rowStart, colStart), Cells(rowEnd, colEnd)).Value = kinmuTable()
    Cells(rowStart, colStart).Select
    MsgBox "自動入力完了"
End Sub
Private Sub 人数カウント(myCnt, myStr, myCol)
    For r = 0 To UBound(kinmuTable, 1)
        If kinmuTable(r, myCol) = myStr Then
            myCnt = myCnt + 1
        End If
    Next
End Sub
Private Sub シャッフル(ByRef myArr() As Integer)
    '配列の順番をシャッフルして返す
    For i = 0 To UBound(myArr)
        Randomize
        rn = Int(UBound(myArr) * Rnd)
        tmp = myArr(i)
        myArr(i) = myArr(rn)
        myArr(rn) = tmp
    Next
End Sub
Sub 新規シート作成()
    Call レイアウト設定
    Dim setYear As Integer          '年
    Dim setMonth As Integer         '月
    Dim thisSheetName As String     '元のシート名
    Dim newSheetName As String      '新規シート名
    Dim fstWeekday As Variant       '1日の曜日
    '年月入力フォームを表示
    flg = False
    UserFormNewSheet.Show
    Select Case flg
        Case True
            setYear = UserFormNewSheet.ComboBoxYear.Value
            setMonth = UserFormNewSheet.ComboBoxMonth.Value
        Case False
            Exit Sub
    End Select
    Unload UserFormNewSheet
    'シートを複製
    newSheetName = setYear & "年" & setMonth & "月"
    For Each ws In Worksheets
        If ws.Name = newSheetName Then
            MsgBox newSheetName & "のシートが既に存在します"
        End If
    Next
    thisSheetName = ActiveSheet.Name
    Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)
    ActiveSheet.Name = newSheetName
    Cells(headRow, headCol).Value = setYear & "年"
    Cells(headRow, headCol + 1).Value = setMonth & "月"
    '内容をクリア
    Range(Cells(headRow, colStart), Cells(rowEnd, colEnd)).ClearContents
    '月から最終列を決定
    Select Case setMonth
        Case 4, 6, 9, 11
            colEnd = colStart + 29
        Case 2
            If setYear Mod 400 <> 0 Then
                If setYear Mod 100 = 0 Then
                    colEnd = colStart + 27
                ElseIf setYear Mod 4 = 0 Then
                    colEnd = colStart + 28
                Else
                    colEnd = colStart + 27
                End If
            End If
        Case Else
            colEnd = colStart + 30
    End Select
    '1日の曜日を取得
    fstWeekday = Weekday(setYear & "/" & setMonth & "/1")
    Select Case fstWeekday
        Case 1
            fstWeekday = "日"
        Case 2
            fstWeekday = "月"
        Case 3
            fstWeekday = "火"
        Case 4
            fstWeekday = "水"
        Case 5
            fstWeekday = "木"
        Case 6
            fstWeekday = "金"
        Case 7
            fstWeekday = "土"
    End Select
    '入力しオートフィル
    Cells(headRow, colStart).Value = "1"
    Cells(headRow, colStart).AutoFill Destination:=Range(Cells(headRow, colStart), Cells(headRow, colEnd)), Type:=xlFillSeries
    Cells(headRow + 1, colStart).Value = fstWeekday
    Cells(headRow + 1, colStart).AutoFill Destination:=Range(Cells(headRow + 1, colStart), Cells(headRow + 1, colEnd)), Type:=xlFillDays
    Cells(rowStart, colStart).Select
End Sub
Sub 職員追加()
    Call レイアウト設定
    Dim addName As Variant      '追加する職員名
    Dim addRow As Integer       '追加する行番号
    Dim setFormula As String    '集計の数式
    addName = Application.InputBox("氏名を入力")
    If addName = "" Or addName = False Then
        Exit Sub
    End If
    '行を追加し上の行をコピペ
    addRow = rowEnd + 1
    Rows(addRow).Insert
    Range(Cells(rowEnd, shukeiColStart), Cells(rowEnd, setteiColEnd)).Copy
    Range(Cells(addRow, shukeiColStart), Cells(addRow, setteiColEnd)).PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    '職員名を入力
    Cells(addRow, headCol).Value = addName
    '設定表の値を0にする
    Range(Cells(addRow, setteiColStart), Cells(addRow, setteiColEnd)).Value = 0
    '集計行の数式修正
    For r = shukeiRowStart To shukeiRowEnd
        setFormula = "=IF(ISBLANK(C$2), """", COUNTIF(C$3:C$" & addRow & ", $A" & r & "))"
        Cells(r, colStart).Formula = setFormula
        Cells(r, colStart).AutoFill Destination:=Range(Cells(r, colStart), Cells(r, colEnd)), Type:=xlFillSeries
    Next
    Cells(addRow, headCol).Select
End Sub
Sub 空白置換()
    Call レイアウト設定
    Dim r As Integer                'テーブルの行番号
    Dim c As Integer                'テーブルの列番号
    Dim setteiArray() As Integer    '公休の設定配列
    '設定リストの公休列を配列に格納
    ReDim setteiArray(rowEnd - rowStart)
    For r = 0 To UBound(setteiArray)
        setteiArray(r) = Cells(rowStart + r, setteiColStart + 1).Value
    Next
    '勤務表をテーブルに格納
    ReDim kinmuTable(rowEnd - rowStart, colEnd - colStart)
    For c = 0 To UBound(kinmuTable, 2)
        For r = 0 To UBound(kinmuTable, 1)
            kinmuTable(r, c) = Cells(rowStart + r, colStart + c).Value
        Next r
    Next c
    '勤務表テーブルを走査
    For r = 0 To UBound(kinmuTable, 1)
        Select Case setteiArray(r)
            Case 1  '常勤
                setStr = "日"
            Case 0  '非常勤'
                setStr = "休"
        End Select
        For c = 0 To UBound(kinmuTable, 2)
            If kinmuTable(r, c) = "" Then
                kinmuTable(r, c) = setStr
            End If
        Next c
    Next r
    Range(Cells(rowStart, colStart), Cells(rowEnd, colEnd)).Value = kinmuTable()
    Cells(rowStart, colStart).Select
End Sub

各ボタンのプロシージャは下記の通り。

ボタンプロシージャ
新規新規シート
追加職員追加
入力自動入力
置換空白置換

そして繰り返し同じ記述が必要な部分についてはプロシージャでまとめています。

レイアウト設定参照する行・列番号を設定
人数カウント1日に対して既に入力されている数をカウント
シャッフル配列の順番をランダムに入れ替える

今回の主な変更点は夜→公休→早→遅という流れを、ループの変数iの値0→1→2→3で表し、Select Caseでそれぞれの処理を独立させたことです。

Case 0の中は夜勤のみの処理で、Case 1の中は公休のみの処理と、明確に分けることで処理を自由にカスタマイズできるようにしています。もし遅の右にシフトを追加した場合は、Case 4でその処理を実行できます。

前回までは共通する処理を行った後、分岐させてそれぞれ独自の処理を行っていましたが、この共通の設定がいつでも共通になるとは限りません。多少コードが重複してもそれぞれで独立させた方が保守面では良いと考えました。

どのシフトでも出てくるような処理があれば、人数カウントのようにプロシージャでまとめてしまうとよいでしょう。

VBA – UserFormNewSheet(フォーム)

Private Sub UserForm_Initialize()
    Dim i As Integer
    '年のコンボボックス 去年、今年、来年
    For i = Year(Date) - 1 To Year(Date) + 1
        ComboBoxYear.AddItem i
    Next
    '月のコンボボックス 12ヶ月
    For i = 1 To 12
        ComboBoxMonth.AddItem i
    Next
    '初期値は翌月
    Select Case Month(Date)
        Case 12
            ComboBoxYear.Value = Year(Date) + 1
            ComboBoxMonth.Value = 1
        Case Else
            ComboBoxYear.Value = Year(Date)
            ComboBoxMonth.Value = Month(Date) + 1
    End Select
End Sub
Private Sub CommandButtonOK_Click()
    flg = True
    UserFormNewSheet.Hide
End Sub
Private Sub CommandButtonCancel_Click()
    UserFormNewSheet.Hide
End Sub

フォーム内のプロシージャは以下の3つです。

UserForm_Initializeフォームを開いた際に年月の値を作成
CommandButtonOK_Click実行ボタンクリック時の処理
CommandButtonCancel_Clickキャンセルボタンクリック時の処理

そしてフォーム内のコンボボックスとボタンには下記のオブジェクト名があてられています。

ComboBoxYear
ComboBoxMonth
実行ボタンCommandButtonOK
キャンセルボタンCommandButtonCancel

コメント

  1. 社員 より:

    こちらのシフト自動作成マクロ、使用させていただいております。大変便利でとても感謝しております。
    1つご質問ですが、夜勤が2日連続にならないようにする為にはどこのコードを書き換えばいいのでしょうか?
    ご教授頂けると幸いです。

    • しめひつ より:

      コメントありがとうございました。お褒めいただき恐縮です。
      168行目~208行目が連続夜勤にする処理なので、この範囲を消せば連続の処理にはなりません。
      ただし、この処理の中で夜勤の翌日を休みにする処理も行っているので注意してください。

      • 社員 より:

        ご返信ありがとうございます。
        追加でご質問なのですが、「夜勤のあと5日間休み」という処理をさせたいのですが、どのようにすれば良いのでしょうか?

        • しめひつ より:

          206行目で翌日休みの処理を行っていますが、5日分ループしてください。
          配列のサイズを超える処理をしようとするとエラーが出るので注意してください。
          例えば、30日の月であれば26日夜勤として27日以降5日間休みとすると、存在しない31日まで入力しようとします。配列は30日の分までしか用意していないのでエラーとなります。
          ループの中で199行目や201行目、配列の最後まで到達していればループを抜けるという条件分岐を記述してください。

          • 社員 より:

            毎度、ご丁寧にありがとうございます。
            私はVBAの知識を深く持ち合わせておりませんので、自分でプログラムを書くことができません!申し訳ないです…
            少しずつ勉強してみようと思います!教えていただきありがとうございます!

          • しめひつ より:

            ぜひ本やネットで調べながら挑戦してみてください^^

  2. sentakubiyori より:

    1日当たりの勤務人数をシフトパターン1~6パターン、各1名ずつ配置したいのですが
    どこの記述を変更すればよいのかわかりません。教えていただけると助かります。

    • しめひつ より:

      コメントありがとうございます。
      人数については表の値を変えることで設定できます。
      パターンごとの処理ですが、サンプルでは夜→公休→早→遅という流れを、ループの変数iの値0→1→2→3で表してSelect Caseでそれぞれの処理を独立させています。
      つまり設定の表に2列追加して、ループの変数iを0~5にすればシフトパターンを6まで増やせます。
      あとはSelect Caseで各パターンの処理を変えればOKです。

  3. 丸猪野 より:

    個人ごとの夜勤や早出の回数を月単位でできるだけ均等に割り当てをしたいのですが、
    どのように記述すればよいでしょうか。ご教授いただけると幸いです。

    • しめひつ より:

      配置の順番はランダムではありますが、必ず配置の順番は均等に回ってきますので、予定が全く無い状態では極めて均等と言えます。
      配置の順番が回ってきたところに予定が入っていると次の周回まで待つ必要があり、そこで均等さが欠けてきます。
      その対策としては、予定が入っていて配置ができなかった人をリザーブしておく配列を用意し、まずはその配列に入っている人から配置していくという風にすれば均等になりやすいのではないかと思います。
      あるいは、夜勤や早出の上限回数を決めて、その回数を超えないように配置するという方法もありますが、これは配置ができない日が出てくると思います。

  4. 社会人 より:

    はじめまして!
    VBAが皆無の私ですが仕事効率を上げる為、こちらのデータを使わせていただきたいと思っております。
    、、、本当に初期の段階で申し訳ないのですがこちらをコピペさせていただいた際、
    private sub レイアウト設定()が黄色くなり、
    コンパイルエラー:変数が定義させていません。と表示され、
    i = headRow のi=が青くなります。

    原因を教えていただけないでしょうか。

  5. 社会人3年目 より:

    はじめまして!
    勤務表の作成に困っており、こちらのサイトに出会いました!

    VBA皆無の私ですが仕事効率を上げる為、
    調べながらこちらのデータを使わせていただきたいと思っております。

    早速ですがコピペをしてみたところ
    コンパイルエラー:変数が定義させていません。
    i = headRow→i=が青くなり
    その上にある
    Private Sub レイアウト設定()→黄色くなりました。

    iの定義はどうすれば良いのでしょうか。
    そもそもVBAのコピペの仕方がまずいのでしょうか、、
    申し訳ないのですが教えていただけると嬉しいです。よろしくお願いします、、。

    • しめひつ より:

      コメントありがとうございます。
      おそらく変数宣言を強制しているのではないかと思います。
      確かに変数iについては宣言しておらず、宣言しなくても基本的に動くのがVBAなのですが、宣言を強制している場合はエラーが出ます。

      コードをコピペしたと仰っておりますが、冒頭に「Option Explicit」という一文はありませんか?
      その一文がありましたその行を削除するか、あるいは変数iを宣言してください。整数型で宣言すれば問題なく動くかと思います。

      • 社会人3年目 より:

        早速のご返答ありがとうございます!
        たしかに上に表記がありました。。
        調べてみたらチェックがかかっていたようで宣言強制を外したところ無くなりました。
        ありがとうございます!

        ですが次に実行時エラー1004で
        アプリケーション定義またはオブジェクト定義のエラーです。との表示があり、
        デバッグをしてみると
        サイト上の29行目
        Do While Cells(i,headCol).Value=””
        が黄色くなります、、。
        こちらはどのような原因が考えられますでしょうか。

        お手数ですがご返答いただけると幸いです。

        • しめひつ より:

          そのご説明だけでは不具合を特定できませんが、おそらくExcelのシートのレイアウトがマクロに対して適したものになっていないのだと思います。
          29行目は日別集計の表を探すループでして、勤務表の下に「夜」「早」「遅」「日」と書かれた表があり、その表の開始行を探すのが目的です。
          職員名が記された最終行を取得後、次に空白じゃないセルが見つかったらそこを日別集計の表の開始行と判断するようにしています。
          おそらく日別集計の表を作っておられないのではないかと推測します。
          このVBAはサンプルで作成したシートのレイアウトに合うように作っていますので、アレンジされる場合でもコードと各オブジェクトの関係を分析されることをおすすめします。

  6. さんや より:

    こちらのシフト自動作成マクロを使用させていただいております。
    すごくわかりやすく、コードにコメントが多くあり感謝しております。

    質問のですが、夜勤、早出、遅出の次の日を『非番又は空白』で返すことで悩んでおります。夜勤は前後を休みか空白にできましたが、早出と遅出で難航しております
    401行目から
    Select Case c
    Case 0
     setFlg = True
     Case Else ‘前日が「遅」の場合は入力しない
     If Not kinmuTable(r, c – 1) Like haichiTable(0, 3) Then
       setFlg = True
      End If
    End Select

    を以下の文に変更しました
    If c = UBound(kinmuTable, 2) Then ‘最終列ならセット
    setFlg = True
    ElseIf c = LBound(kinmuTable, 2) Then ‘初列ならセット?
    setFlg = True
    ElseIf kinmuTable(r, c – 1) = “” And kinmuTable(r, c + 1) = “” Then
    ‘前日および翌日が空白ならセット?
    setFlg = True
    End If

    という文に変えましたが、思いのほかうまく作動できませんでした。

    ご教授頂けると幸いです。

    • しめひつ より:

      コメントありがとうございます。
      うまく作動しないというのがどういう状況なのかがわかりません。
      エラーで中止してしまうのか、前日または翌日が空白であっても入力されてしまうのかといったことを詳細に教えてください。
      夜勤でうまくいったのであれば同じやり方を早や遅でやればできるはずです。デバッグモードで変数の中身や処理の状況を確認したら解決できるかと思います。

      • さんや より:

        返信ありがとうございます。
        困っていることが2つあります。

        一つ目は
        夜勤のあとに公休などが入力されているためか、早出や遅出がセットされません。
        この場合、Case 0~3の内容の順序変更すればいいのでしょうか?

        二つ目は
        If c = kinmuTable(r, c – 1) = “” And UBound(kinmuTable, 2) Then
        ’前日が空白で最終日ならセット
        等とするとインデックスエラーが発生します。
        そのため最終日なら前日が仕事の日でも最終日に仕事がセットされてしまいます。

        お手数をおかけして申し訳ございませんが、よろしくお願いいたします。

        • しめひつ より:

          1つ目については、夜勤の翌日は公休が入力される仕様なので、翌日に公休が入力されないように変更するか、仰るように入力の順番を変えてください。

          2つ目については、前日が仕事の日でも最終日に仕事がセットされることがおかしいのではなく、インデックスエラーが発生するのであれば処理が中止されて困っているということですね。
          そのIf文はAndの後ろの書き方が間違っているのですが、それだと別のエラーが出るのでおそらくこのコメントに書く段階で間違ったものだと解釈します。
          インデックスエラーということは配列の指定の仕方が間違っているのだと思います。最初にいただいたコメントではElse Ifで分岐していて回避できているかと思いましたが、その書き方ですとcが0の時にkinmuTableの二次元目のインデックスは-1を参照するのでエラーになります。
          エラーにならないようにさらに分岐させてください。

コメントする前にお読みください

プログラミングに関する質問について、詳細なコードはお答えしませんのでご了承ください。
また、迷惑コメント防止のために初回のコメント投稿は承認制です。投稿が反映されるまで少し時間がかかります。