【Excel VBA】シフト表自動作成マクロを二次元配列で高速処理にしました

【Excel VBA】シフト自動作成マクロを作り直しました
前にExcelでシフト自動作成マクロを作りました。現在のところこのブログで最も見られている記事で、相当シフト作成に苦労されているところが多いんだなと見受けます。 内容的にはあらかじめ予定をセットしておいてプログラムを走らせたら、ランダムで配...

このブログの人気記事は相変わらずシフト表自動作成マクロに関する記事です。よっぽど勤務を組むのに苦労している人が多いようです。

Excelのセル、すなわちオブジェクト上で情報の書き込みを行うと結構処理が遅くなります。

そういう時は変数や配列を使って処理を行うと速くなります。前回作ったものも配列を使ってましたが、条件を満たす度にオブジェクトに書き込んでいたため、完了までに時間がかかってました。

また、複数の配列を使ってインデックス番号で配列同士を関連付けしていましたが、配列がたくさんできすぎてややこしくなっていました。

そこで勤務表や設定表を二次元配列に格納して配列上ですべて処理を行い、オブジェクトへの書き込みは1回にまとめて処理を高速化しました。

※改良に改良を重ねた最新版は下のリンクからどうぞ。

スポンサーリンク

プログラムの内容

サンプルデータはこちら。

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

こんな感じのレイアウトに作り変えました。

メインとなる勤務表、その右に職員の1ヶ月分の集計、下には各日付の配置の集計、集計表の右に職員ごとに配置の有無を設定する表、さらにその右上に条件を設定する表があります。

新規シート

新規シートボタンを押すと西暦と月を入力し、内容がリセットされて日付と曜日を整えられた新しいシートができあがります。

職員追加

職員追加ボタンを押すと最後の行に追加します。集計表と設定表の数式や値は自動で入力され、氏名は1列目に入れたら集計表と設定表にも自動で表示されます。

マクロの設定

勤務表の各セルはドロップダウンリストでの選択式です。

「夜」「早」「遅」が入力されるとセルの背景色が変わるように条件付き書式を設定しています。

自動入力では既に入力されたところはセットしないようにしているため、希望休や勤務希望をあらかじめ入力した上でマクロを実行します。

設定表では各配置の人数を決められます。夜勤がない場合は人数を0にしておけば処理は行われません。

各職員の各配置について、入力の対象であれば「1」を入力します。

右の条件はそれぞれ以下のような内容です。

夜勤労働数1労働, 1.5労働, 2労働夜勤労働数によって処理が変わります
連続夜勤あり, なし1労働夜勤における連続夜勤の設定です
値にかかわらず、1.5労働の場合はあり、2労働の場合はなしに変更されます
連続夜勤後連休あり, なし1労働夜勤における、連続夜勤の後は連休にする設定です
1.5労働と2労働の場合は明け→休みとなるためこの設定は無効です
遅→早禁止あり, なし遅出の翌日が早出になることを禁止します
ありで禁止、なしで遅→早の配置を許可します

2021年4月17日機能追加:公休のON/OFF

この記事を投稿した時点のものと変更している点があります。

公休の下が0か1の選択式になっています。他の項目では人数の設定ですが、ここでは1ならON、0ならOFFの切り替えです。

公休の振り分けを行わない場合は0にすればスキップされます。ただし、夜勤の翌日以降の公休については行われますので注意です。

マクロの実行

自動入力ボタンを押すと一瞬でできあがります。前回のものとは比にならない速度です。

プログラミング

VBA

'共通変数
Dim rowStart As Integer     '勤務表の開始行
Dim rowEnd As Integer       '勤務表の最終行
Dim colStart As Integer     '勤務表の開始列
Dim colEnd As Integer       '勤務表の最終行
Dim headRow As Integer      '日付のある行
Dim cfgCol As Integer       '設定表の開始列
Dim cfgColEnd As Integer    '設定表の最終列
Sub 基本設定(rowStart, rowEnd, colStart, colEnd, headRow, cfgCol, cfgColEnd)
    rowStart = 4                                    '勤務表の開始行
    colStart = 3                                    '勤務表の開始列
    headRow = 2                                     '日付のある行
    cfgCol = 43                                     '設定表の開始列
    Cells(headRow, 1).Select
    rowEnd = Selection.End(xlDown).Row              '勤務表の最終行を取得
    colEnd = Selection.End(xlToRight).Column        '勤務表の最終列を取得
    Cells(headRow, cfgCol).Select
    cfgColEnd = Selection.End(xlToRight).Column     '設定表の最終列を取得
End Sub
Sub 自動入力()
    Call 基本設定(rowStart, rowEnd, colStart, colEnd, headRow, cfgCol, cfgColEnd)
    Dim maxHol As Integer           '公休日数
    Dim holStr As String            '「公休」文字列
    Dim holiStr As String           '「HOLI」文字列(自動で入力したことを表す仮表記)
    Dim aveHol As Integer           '1日あたりの公休人数
    Dim tblArr() As String          '勤務表の配列
    Dim cfgArr() As Integer         '設定の配列(各配置の設定)
    Dim cfg2Arr() As String         '設定の配列(夜勤の労働数などの条件)
    Dim cntArr() As Variant         '各配置の人数
    Dim rowArr() As Integer         '行番号シャッフル用
    Dim arrCnt As Integer           '配列用カウンタ
    Dim blankArr() As Integer       '公休セット時の空き列番号
    Dim blankCnt As Integer         '空き列番号の配列用カウンタ
    Dim holiArr() As Integer        '公休セット時の「HOLI」列番号
    Dim holiCnt As Integer          'HOLI列番号の配列用カウンタ
    Dim koukyuStr As String         '公休文字列
    Dim yasumiStr As String         '非常勤休み文字列
    Dim pNenStr As String           '午後年休文字列
    Dim pHolStr As String           '非常勤午後休文字列
    Dim akeStr As String            '明け文字列
    Dim roudou As String            '夜勤の労働数
    Dim renzokuFlg As Boolean       '連続夜勤フラグ
    Dim renkyuflg As Boolean        '連続夜勤後連休フラグ
    Dim osohayaFlg As Boolean       '遅→早禁止フラグ
    Dim thisSheetName As String     '元のシート名
    Dim setFlg As Boolean           'セットフラグ
    koukyuStr = "公休"              '公休の表記
    yasumiStr = "休"                '非常勤職員の休み表記
    pNenStr = "P年"                 '常勤職員の夜勤明けは午後年休
    pHolStr = "P休"                 '非常勤職員の夜勤明けは午後休
    akeStr = "明け"                 '明けの表記を指定
    '条件の値を配列にセット
    ReDim cfg2Arr(3)
    For i = 0 To 3
        cfg2Arr(i) = Cells(headRow, cfgColEnd + 2 + i).Value
    Next
    '夜勤の労働数をセット
    roudou = cfg2Arr(0)
    '連続夜勤フラグ
    Select Case cfg2Arr(1)
        Case "あり"
            renzokuFlg = True
        Case "なし"
            renzokuFlg = False
    End Select
    '連続夜勤フラグを1.5労働の場合はTrue、2労働夜勤の場合はFalseに強制変更
    Select Case roudou
        Case "1.5労働"
            renzokuFlg = True
        Case "2労働"
            renzokuFlg = False
    End Select
    '連続夜勤後連休フラグ(1労働夜勤の場合のみ有効)
    Select Case cfg2Arr(2)
        Case "あり"
            renkyuflg = True
        Case "なし"
            renkyuflg = False
    End Select
    '遅→早禁止フラグ
    Select Case cfg2Arr(3)
        Case "あり"
            osohayaFlg = True
        Case "なし"
            osohayaFlg = False
    End Select
    '最終列から公休日数を決定
    Select Case colEnd
        Case 33
            maxHol = 10
        Case 30
            maxHol = 8
        Case Else
            maxHol = 9
    End Select
    'シートを複製
    thisSheetName = ActiveSheet.Name
    Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)
    ActiveSheet.Name = thisSheetName & "作成済"
    '勤務表を配列に格納
    ReDim tblArr(rowEnd - rowStart, colEnd - colStart)
    For c = 0 To colEnd - colStart
        For r = 0 To rowEnd - rowStart
            tblArr(r, c) = Cells(rowStart + r, colStart + c).Value
        Next r
    Next c
    '設定表を配列に格納
    ReDim cfgArr(rowEnd - rowStart, cfgColEnd - cfgCol)
    For c = 0 To cfgColEnd - cfgCol
        For r = 0 To rowEnd - rowStart
            cfgArr(r, c) = Cells(rowStart + r, cfgCol + c).Value
        Next r
    Next c
    '配置名と人数を配列に格納
    ReDim cntArr(1, cfgColEnd - cfgCol)
    For c = 0 To cfgColEnd - cfgCol
        For r = 0 To 1
            cntArr(r, c) = Cells(headRow + r, cfgCol + c).Value
        Next r
    Next c
    'セット開始
    '0:夜 1:早 2:遅
    For i = 0 To 2
        '設定表で1になっている行番号を配列にセット
        arrCnt = 0
        ReDim rowArr(arrCnt)
        For r = 0 To UBound(cfgArr, 1)
            If cfgArr(r, i) = 1 Then
                ReDim Preserve rowArr(arrCnt)
                rowArr(arrCnt) = r
                arrCnt = arrCnt + 1
            End If
        Next
        '配列をシャッフルしカウンタをリセット
        Call シャッフル(rowArr(), arrCnt)
        '各列を処理
        For c = 0 To UBound(tblArr, 2)
            setCnt = cntArr(1, i)       '人数をカウンタにセット
            shuffleFlg = False          'シャッフルフラグ(シャッフルは1列あたり1回まで)
            '各行を処理
            For r = 0 To UBound(tblArr, 1)
                '既にセットされていたらカウンタを減らす
                If tblArr(r, c) Like cntArr(0, i) & "*" Then
                    setCnt = setCnt - 1
                    If setCnt = 0 Then
                        Exit For
                    End If
                End If
            Next r
            'カウンタが0になるまでセット
            Do While setCnt > 0
                '複数配置する場合はナンバリングする
                Select Case cntArr(1, i)
                    Case 1
                        setStr = cntArr(0, i)
                    Case Else
                        setStr = cntArr(0, i) & setCnt
                End Select
                '対象セルが空白の場合はセット
                If tblArr(rowArr(arrCnt), c) = "" Then
                    Select Case i
                        Case 0      '夜勤処理
                            '夜勤は翌日以降の状況を確認してからセット
                            setFlg = False
                            Select Case c
                                Case UBound(tblArr, 2)  '最終列ならば気にする必要ないのでセット
                                    setFlg = True
                                Case Else
                                    If tblArr(rowArr(arrCnt), c + 1) = "" Then  '翌日が空白ならセット
                                        setFlg = True
                                    End If
                            End Select
                            If setFlg = True Then
                                'セットしカウンタを減らす
                                tblArr(rowArr(arrCnt), c) = setStr
                                setCnt = setCnt - 1
                                '連続処理
                                If c <> UBound(tblArr, 2) Then
                                    '常勤か非常勤かで休みの文字列を変更
                                    Select Case cfgArr(rowArr(arrCnt), 3)
                                        Case 1
                                            holStr = koukyuStr
                                        Case 0
                                            holStr = yasumiStr
                                    End Select
                                    Select Case renzokuFlg
                                        Case True   '連続夜勤ありの場合
                                            '翌日の夜勤の配置状況を確認
                                            setCnt2 = cntArr(1, i)
                                            For n = 0 To UBound(tblArr, 1)
                                                If tblArr(n, c + 1) Like cntArr(0, i) & "*" Then
                                                    setCnt2 = setCnt2 - 1
                                                    If setCnt2 = 0 Then
                                                        Exit For
                                                    End If
                                                End If
                                            Next n
                                            If setCnt2 >= 1 Then
                                                'カウンタが残って入れば連続夜勤設定
                                                Select Case cntArr(1, i)
                                                    Case 1
                                                        setStr = cntArr(0, i)
                                                    Case Else
                                                    setStr = cntArr(0, i) & setCnt2
                                                End Select
                                                tblArr(rowArr(arrCnt), c + 1) = setStr
                                                '翌々日以降の処理
                                                If c <> UBound(tblArr, 2) - 1 Then
                                                    Select Case roudou
                                                        Case "1.5労働"
                                                            '明け→休みにする
                                                            tblArr(rowArr(arrCnt), c + 2) = akeStr
                                                            If c <> UBound(tblArr, 2) - 2 Then
                                                                tblArr(rowArr(arrCnt), c + 3) = holStr
                                                            End If
                                                        Case "1労働"
                                                            tblArr(rowArr(arrCnt), c + 2) = holStr
                                                            '連休フラグが立っていれば連休にする
                                                            If renkyuflg = True And c <> UBound(tblArr, 2) - 2 Then
                                                                tblArr(rowArr(arrCnt), c + 3) = holStr
                                                            End If
                                                    End Select
                                                End If
                                            Else
                                                'カウンタが0の場合は連続夜勤にしない
                                                Select Case roudou
                                                    Case "1.5労働"  '1.5労働の場合は明けに午後年休(非常勤は午後休)を使用
                                                        Select Case cfgArr(rowArr(arrCnt), 3)
                                                            Case 1
                                                                tblArr(rowArr(arrCnt), c + 1) = pNenStr
                                                            Case 0
                                                                tblArr(rowArr(arrCnt), c + 1) = pHolStr
                                                        End Select
                                                        '翌々日は休み'
                                                        If c <> UBound(tblArr, 2) - 1 Then
                                                            tblArr(rowArr(arrCnt), c + 2) = holStr
                                                        End If
                                                    Case "1労働"    '翌日は休み
                                                        tblArr(rowArr(arrCnt), c + 1) = holStr
                                                End Select
                                            End If
                                        Case False  '連続夜勤なしの場合
                                            Select Case roudou
                                                Case "2労働"    '明け→休みにする
                                                    tblArr(rowArr(arrCnt), c + 1) = akeStr
                                                    If c <> UBound(tblArr, 2) - 1 Then
                                                        tblArr(rowArr(arrCnt), c + 2) = holStr
                                                    End If
                                                Case "1労働"    '翌日は休み
                                                    tblArr(rowArr(arrCnt), c + 1) = holStr
                                            End Select
                                    End Select
                                End If
                            End If
                        Case 1      '早出処理
                            If osohayaFlg = True Then   '遅→早が禁止の場合
                                setFlg = False
                                Select Case c
                                    Case 0      '最初の列であれば気にする必要がないためセット
                                        setFlg = True
                                    Case Else   '前日が遅出の場合はセットしない
                                        If Not tblArr(rowArr(arrCnt), c - 1) Like cntArr(0, 2) & "*" Then
                                            setFlg = True
                                        End If
                                End Select
                                If setFlg = True Then   '前日が遅出でなければセット
                                    tblArr(rowArr(arrCnt), c) = setStr
                                    setCnt = setCnt - 1
                                End If
                            Else    '遅→早が禁止でない場合はセット
                                tblArr(rowArr(arrCnt), c) = setStr
                                setCnt = setCnt - 1
                            End If
                        Case 2      '遅出処理
                            If osohayaFlg = True Then   '遅→早が禁止の場合
                                setFlg = False
                                Select Case c
                                    Case UBound(tblArr, 2)  '最終列の場合は気にする必要がないためセット
                                        setFlg = True
                                    Case Else               '翌日が早出の場合はセットしない
                                        If Not tblArr(rowArr(arrCnt), c + 1) Like cntArr(0, 1) & "*" Then
                                            setFlg = True
                                        End If
                                End Select
                                If setFlg = True Then   '翌日が早出でなければセット
                                    tblArr(rowArr(arrCnt), c) = setStr
                                    setCnt = setCnt - 1
                                End If
                            Else    '遅→早が禁止でない場合はセット
                                tblArr(rowArr(arrCnt), c) = setStr
                                setCnt = setCnt - 1
                            End If
                    End Select
                End If
                '配列用カウンタが最後までいったらシャッフルし直し
                If arrCnt = UBound(rowArr()) Then
                    Call シャッフル(rowArr(), arrCnt)
                    Select Case shuffleFlg  '1列あたりシャッフルは1回まで
                        Case False
                            shuffleFlg = True
                        Case True
                            setCnt = 0
                    End Select
                Else
                    arrCnt = arrCnt + 1
                End If
            Loop
        Next c
        '夜勤処理後に公休処理
        If cntArr(1, 3) = 1 And i = 0 Then
            holStr = koukyuStr
            holiStr = "HOLI"
            arrCnt = 0
            '公休配置の職員を配列に格納
            ReDim rowArr(arrCnt)
            For r = 0 To UBound(cfgArr, 1)
                If cfgArr(r, 3) = 1 Then
                    ReDim Preserve rowArr(arrCnt)
                    rowArr(arrCnt) = r
                    arrCnt = arrCnt + 1
                End If
            Next r
            Call シャッフル(rowArr(), arrCnt)
            '1日あたりの公休人数を算出
            aveHol = Round((maxHol * UBound(rowArr) + 1) / UBound(tblArr, 2), 0)
            '各列を処理
            For c = 0 To UBound(tblArr, 2)
                shuffleFlg = False
                setCnt = aveHol
                Do While setCnt > 0
                    If tblArr(rowArr(arrCnt), c) = "" Then
                        tblArr(rowArr(arrCnt), c) = holiStr     '希望休と区別にするために仮で「HOLI」とセット
                        setCnt = setCnt - 1
                    End If
                    '配列用カウンタが最後までいったらシャッフルし直し
                    If arrCnt = UBound(rowArr) Then
                        Call シャッフル(rowArr(), arrCnt)
                        Select Case shuffleFlg
                            Case False
                                shuffleFlg = True
                            Case True
                                setCnt = 0
                        End Select
                    Else
                        arrCnt = arrCnt + 1
                    End If
                Loop
            Next c
            '公休をチェック
            For n = 0 To UBound(rowArr)
                setCnt = 0
                blankCnt = 0
                ReDim blankArr(blankCnt)
                holiCnt = 0
                ReDim holiArr(holCnt)
                For c = 0 To UBound(tblArr, 2)
                    Select Case tblArr(rowArr(n), c)
                        Case holStr     '公休の場合(希望休や夜勤後の休み)
                            setCnt = setCnt + 1
                        Case holiStr    'HOLIの場合(公休日数オーバーの場合は削除の対象)
                            setCnt = setCnt + 1
                            ReDim Preserve holiArr(holiCnt)
                            holiArr(holiCnt) = c
                            holiCnt = holiCnt + 1
                        Case ""         '空白の場合(公休日数が足りない場合は追加の対象)
                            ReDim Preserve blankArr(blankCnt)
                            blankArr(blankCnt) = c
                            blankCnt = blankCnt + 1
                    End Select
                Next c
                Select Case setCnt
                    Case Is < maxHol    '公休日数が足りない場合
                        Call シャッフル(blankArr(), arrCnt)
                        Do While setCnt < maxHol
                            tblArr(rowArr(n), blankArr(arrCnt)) = holiStr
                            setCnt = setCnt + 1
                            If arrCnt = UBound(blankArr) Then
                                setCnt = maxHol     '空白列がない場合はスキップする
                            Else
                                arrCnt = arrCnt + 1
                            End If
                        Loop
                    Case Is > maxHol    '公休日数がオーバーしている場合
                        Call シャッフル(holiArr(), arrCnt)
                        Do While setCnt > maxHol
                            tblArr(rowArr(n), holiArr(arrCnt)) = ""
                            setCnt = setCnt - 1
                            If arrCnt = UBound(holiArr) Then
                                setCnt = maxHol     'HOLIがない場合はスキップする
                            Else
                                arrCnt = arrCnt + 1
                            End If
                        Loop
                End Select
            Next n
            'HOLIを公休に変換
            For r = 0 To UBound(tblArr, 1)
                For c = 0 To UBound(tblArr, 2)
                    If tblArr(r, c) = holiStr Then
                        tblArr(r, c) = holStr
                    End If
                Next c
            Next r
        End If
    Next i
    '配列を勤務表にセットし処理完了
    Range(Cells(rowStart, colStart), Cells(rowEnd, colEnd)).Value = tblArr()
    Cells(rowStart, colStart).Select
    MsgBox "処理完了"
End Sub
Sub シャッフル(ByRef myArr() As Integer, ByRef arrCnt 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
    '配列用カウンタをリセット
    arrCnt = 0
End Sub
Sub 新規()
    Call 基本設定(rowStart, rowEnd, colStart, colEnd, headRow, cfgCol, cfgColEnd)
    Dim thisYear As Variant         '年
    Dim thisMonth As Variant        '月
    Dim thisSheetName As String     'シート名
    Dim fstWeekday As Variant       '1日の曜日
    '年月入力
    thisYear = Application.InputBox("西暦を半角4桁の数字で入力してください。")
    If thisYear = False Then
        Exit Sub
    End If
    If Len(thisYear) <> 4 Then
        MsgBox ("西暦は4桁で入力してください。" _
            & vbCrLf & "処理を中止します。")
        Exit Sub
    End If
    thisMonth = Application.InputBox("月を半角で入力してください。(1~12)")
    If thisMonth = False Then
        Exit Sub
    End If
    If thisMonth < 1 Or thisMonth > 12 Then
        MsgBox ("月は1~12で入力してください。" _
            & vbCrLf & "処理を中止します。")
        Exit Sub
    End If
    'シートを複製
    thisSheetName = ActiveSheet.Name
    Worksheets(thisSheetName).Copy Before:=Worksheets(thisSheetName)
    ActiveSheet.Name = thisYear & "." & thisMonth
    Cells(headRow, 1).Value = thisYear & "年"
    Cells(headRow, 2).Value = thisMonth & "月"
    '内容をクリア
    Range(Cells(headRow, colStart), Cells(rowEnd, colEnd)).ClearContents
    '月から最終列を決定
    Select Case thisMonth
        Case 4, 6, 9, 11
            colEnd = 32
        Case 2
            If thisYear Mod 400 <> 0 Then
                If thisYear Mod 100 = 0 Then
                    colEnd = 30
                ElseIf thisYear Mod 4 = 0 Then
                    colEnd = 31
                Else
                    colEnd = 30
                End If
            End If
        Case Else
            colEnd = 33
    End Select
    '1日の曜日を取得
    fstWeekday = Weekday(thisYear & "/" & thisMonth & "/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 基本設定(rowStart, rowEnd, colStart, colEnd, headRow, cfgCol, cfgColEnd)
    Dim shukeiCol As Integer    '集計表の開始列
    shukeiCol = 35
    '行を追加し上の行をコピペ
    Rows(rowEnd + 1).Insert
    Range(Cells(rowEnd, shukeiCol), Cells(rowEnd, cfgColEnd)).Copy
    Range(Cells(rowEnd + 1, shukeiCol), Cells(rowEnd + 1, cfgColEnd)).PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    '設定表の値を0にする
    For i = cfgCol To cfgColEnd
        Cells(rowEnd + 1, i).Value = 0
    Next
    Cells(rowEnd + 1, 1).Select
End Sub

すべて1つのモジュールにまとめました。

ハイライトのこととかは前回やったので割愛します。

二次元配列への格納

二次元配列へ格納するには、配列をVariant型で宣言しておき、Rangeメソッドで指定して範囲を代入すれば一発で格納できます。

ただ、この場合だとデータ型を指定できないため、それにより不都合がある場合は今回のようにループで1つずつ格納していくことをおすすめします。そんなに時間はかかりません。

今回の場合だと、空白セルは””で格納してほしいところがEmpty 値になっちゃうのがいやだったので、配列をString型で宣言してループで格納しました。

コメント

  1. 大舘  より:

    こんにちは。
    稼働日と非稼働日で配置人数を変えたい場合に良い方法はありませんか?
    例えば、平日は、2人、休日は、3人等。

    • しめひつ より:

      コメントありがとうございます。
      Excel上で完結させる方法としては、基本の人数設定を2人にしておき、勤務表下部の人数追加設定で必要な日だけ1人追加するというやり方が簡単です。

  2. o より:

    ご教示いただきありがとうございます。素人な質問で申し訳ないですが勤務表下部の人数追加設定の方法がわかりません。。ご教示いただけないでしょうか?

    • しめひつ より:

      コメントありがとうございます。

      例えば、夜勤の人数が1人設定の場合では各日に1人夜勤を配置するのですが、人数追加設定で1と入力した日については、その日は夜勤を+1人として合計2人配置することになります。

  3. o より:

    早々のご回答ありがとうございます。
    追加したい日の集計部分に1と入れる認識であっていますか?

    • しめひつ より:

      先日コメントいただいた大館様でしたか。
      その時のコメントで「勤務表下部の人数追加設定」と申しておりましたが、これは別のところで作ったものの仕様で、ここで公開しているものでは未実装でした。失礼いたしました。

      参考までに、その仕様では勤務表の下部に集計表の他に人数追加用の表があり、数字を入れることで配置人数を増やせるというものです。
      VBAでは138行目のsetCntに人数を入れる際に、その表の値もプラスするという形で人数を変更していました。

  4. o より:

    ご回答いただきありがとうございます。大変おこがましいお願いですが実装したものを送っていただくことは、可能でしょうか?

    • しめひつ より:

      恐れ入りますが、お送りすることはできかねます。

      この記事を参考にしてご自身で作成したり改造するのは応援するのですが、コードの書き方を伝えるなど直接的な支援はしておりません。

      もしマクロの作成依頼をされるのであれば、下記リンクのページ内にあるクラウドソーシング(ランサーズ or クラウドワークス)からご依頼ください。

      https://www.iehohs.com/about/

  5. o より:

    ありがとうございます。
    参考にしながら自作していきます。

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

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