【Excel VBA】夜勤当番表作成ツール

■ツールの概要

スタッフの夜勤当番表を自動で生成するマクロを作成する。

【条件】
・スタッフに当日夜勤不可の場合は、「不」を入力できるようにする。
・当日夜勤の場合は、毎日1人、夜勤担当者に「夜」を付与する。
※なお、「不」がついたスタッフメンバには、「夜」は付与しない。
・平日/休祝日に何回夜勤をしているか表示する。
・一人のスタッフに対して、直近の夜勤から、何日間か間隔を空けるように設定できる。
・予め、管理者が「夜」を付与できるようにする。
・会社の休日(創立記念日など)も「休祝日」として設定可能とする。
・「夜」の文字だけを消す初期化処理を作る。

【完成イメージ】

■シートの仕様

本節では、シート名、シート内の関数と書式を示す。

▼シート名

シート名は以下の通り設定する。

・「main」シート
夜勤当番表の本紙

・「休日祝日マスタ」シート
休日や祝日を設定

▼シート内の関数と書式

・年月の設定

年月(B4セル)は以下の通り、月初(1日)を設定し、YYYY/MM表記とする。

「main」シートの計算式

・日にちの設定

日にちについて、1日目(B5セル)は年月(B4セル)と同値とし、日にち(D)のみ表示する。

「main」シートの計算式

2日目(C5セル)以降は前日の日にちに+1したものとする。

「main」シートの計算式

・曜日の設定

曜日(B6セル)は以下の条件とする。
▼IFERROR関数:日にち(B5セル)を「休日祝日マスタ」シートから検索する。
真:休日・祝日であるならば、それぞれ「休」・「祝」を設定する。
偽:TEXT関数で日にち(B5セル)を曜日に表示する。

「main」シートの計算式
「休日祝日マスタ」シート

なお、「土」・「日」・「休」・「祝」の場合は、「夜」・「不」入力セルをピンク色にする。

■フローチャート

▼全体の概要フロー

・表初期化処理


・夜勤当番表作成処理

▼表初期化処理

▼夜勤当番表作成処理

▼各メンバ配列作成処理

▼メンバ数カウント処理

▼事前夜勤当番加算処理

■プログラム仕様

▼表初期化処理

引数:
・なし

戻り値:
・なし

概要:
・「main」シートの夜勤当番表について、「夜」の文字を削除する。
・各メンバの平日/夜勤日数を初期化(0)。

インプット処理内容アウトプット
mainシートをセットする。
行カウンタと列カウンタに初期値をセットする。
【ループ処理】メンバ分ループ処理(開始)
【ループ処理】日付分ループ処理(開始)
【条件分岐】セルの値
▼「夜」の場合
・空白にする。
【セルの値】
空文字
列カウンタをインクリメント
【ループ処理】日付分ループ処理(終了)
各メンバの平日/休日夜勤日数を初期化する。【セルの値】
0
行カウンタをインクリメントする。
列カウンタを初期化する。
【ループ処理】メンバ分ループ処理(終了)
完了メッセージ出力【メッセージボックス】
初期化しました

▼夜勤当番表作成処理

引数:
・なし

戻り値:
・なし

概要:
・夜勤当番表に「夜」を出力していく。

インプット処理内容アウトプット
mainシートをセットする。
【関数呼び出し】各メンバ配列作成処理(*1)
各メンバ配列を作成する。
【関数呼び出し】事前夜勤当番加算処理
メンバ配列に既存の夜勤担当を付与する。
初期値をセットする。
【セルの値】
夜勤間隔日数
夜勤間隔日数を取得する。
【ループ処理】日付分ループ処理(開始)
【条件分岐】セルの値:平日・休日判定
▼曜日が「休・祝・土・日」の場合
フラグを休日にする。(2:配列の休日日数の要素数)
▼曜日が「月〜金」の場合
フラグを平日にする。(1:配列の平日日数の要素数)
【ループ処理】メンバ数分ループ処理(開始)
【条件分岐】セルの値
▼「夜」が設定されている場合
├ 夜勤担当者フラグをTrueにする。
├【条件分岐】メンバ配列の直近夜勤日(*1)
|▼空ではない場合
|└ 【条件分岐】「対象日」-「メンバの直近夜勤日」<= 「夜勤間隔日数」
| ▼Trueの場合
| └ エラーメッセージを出力し、異常終了する。
└ 直近夜勤日を対象者のメンバ配列へ入れる。
異常終了時
【メッセージ】
夜勤間隔エラー
【条件分岐】夜勤担当者フラグ
▼Falseの場合
└【条件分岐】セルの入力値
▼「不」ではない場合
└【条件分岐】メンバ配列の直近夜勤日(*1)
▼空の場合
└ 夜勤回数が最も少ない場合、メンバカウンタと行を保持する。
▼空ではない場合
└【条件分岐】 「対象日」-「メンバの直近夜勤日」>「夜勤間隔日数」
▼Trueの場合
└ 夜勤回数が最も少ない場合、メンバカウンタと行を保持する。
【ループ処理】メンバ数分ループ処理(終了)
【条件分岐】夜勤担当者フラグ
▼Falseの場合
└ 【条件分岐】夜勤可能者
▼いない場合
└ 夜勤割り当てエラーメッセージを出力し、異常終了する。
▼いる場合
└ 夜勤割り当てを行う。
正常系
【セルの値】
「夜」を出力

異常系
【メッセージ】
夜勤割り当て不可
【ループ処理】日付分ループ処理(終了)
【ループ処理】メンバ数分ループ処理(開始)
各メンバの平日/休祝夜勤日数をセットする。【セル値】
平日/休日夜勤日数
【ループ処理】メンバ数分ループ処理(終了)
完了メッセージ出力【メッセージ】
完了

(*1)メンバ配列の構成は以下の通り。
[[メンバ1, 平日日数, 休日日数, 直近夜勤日],[メンバ2, 平日日数, 休日日数, 直近夜勤日],・・・]

▼各メンバ配列作成処理

引数:
・シート名

戻り値:
・2次元配列

概要:
・夜勤当番表のメンバ数分の2次元配列を作成する。(*1)

インプット処理内容アウトプット
【関数呼び出し】メンバ数カウント処理
「main」シートのメンバ数を取得する。
メンバ数分の2次元配列を作成する。(*1)
【ループ処理】メンバ数分繰り返す。(開始)
配列にメンバの名前をセットする。
配列に平日夜勤日数の初期値(0)をセットする。
配列に休日夜勤日数の初期値(0)をセットする。
配列に直近夜勤日の初期値(空文字)をセットする。
【ループ処理】メンバ数分繰り返す。(終了)
戻り値として、2次元配列を返す。【戻り値】
2次元配列

(*1)メンバ配列の構成は以下の通り。
[[メンバ1, 平日日数, 休日日数, 直近夜勤日],[メンバ2, 平日日数, 休日日数, 直近夜勤日],・・・]

▼メンバ数カウント処理

引数:
・シート名

戻り値:
・メンバ数

概要:
・夜勤当番表のメンバ数をカウントする。

インプット処理内容アウトプット
【ループ処理】メンバ数分繰り返す(開始)
メンバの数をカウントする。
【ループ処理】メンバ数分繰り返す(終了)
戻り値として、メンバ数を返す。【戻り値】
メンバ数

▼事前夜勤当番加算処理

引数:
・シート名
・2次元配列

戻り値:
・2次元配列

処理概要:
・あらかじめ入力されている、「夜」をメンバごとに、平日/休日ごとにカウントし、2次元配列に格納する。(*1)

インプット処理内容アウトプット
【ループ処理】メンバ数分ループ処理(開始)
【ループ処理】日数分ループ処理(開始)
【条件分岐】セルの値:平日・休日判定
▼曜日が「休・祝・土・日」の場合
フラグを休日にする。(2:配列の休日日数の要素数)
▼曜日が「月〜金」の場合
フラグを平日にする。(1:配列の平日日数の要素数)
「夜」文字が入力されている対象のメンバについて、
2次元配列の平日/休日数をそれぞれカウントする。
【ループ処理】日数分ループ処理(終了)
【ループ処理】メンバ数分ループ処理(終了)
戻り値として、2次元配列(平日/休日数反映済み)を返す【戻り値】
2次元配列

(*1)メンバ配列の構成は以下の通り。
[[メンバ1, 平日日数, 休日日数, 直近夜勤日],[メンバ2, 平日日数, 休日日数, 直近夜勤日],・・・]

■モジュール構造

モジュール構造を以下に示す。

ソースを実装しているのは、「ThisWorkbook」、「 CommonConst」、「Func」である。

詳細は以下の通り。

「ThisWorkbook」
・表初期化処理(メイン処理)
・夜勤当番表作成処理(メイン処理)

「CommonConst」
・定数

「Func」
・各メンバ配列作成処理
・メンバ数カウント処理
・事前夜勤当番加算処理

■定数

・モジュール/CommonConst


' シート名の定義
Public Const SHTNAME_MAIN As String = "main"

' mainシートの定数
Public Const INTERVAL_YAKIN_ROW As Integer = 2        ' 夜勤間隔日入力行
Public Const INTERVAL_YAKIN_COL As Integer = 30       ' 夜勤間隔日入力列
Public Const DAY_ROW            As Integer = 5        ' 日付行
Public Const DAY_OF_WEEK_ROW    As Integer = 6        ' 曜日行

Public Const START_MEMBER_ROW As Integer = 7       ' メンバ開始行
Public Const START_MEMBER_COL As Integer = 1       ' メンバ開始列
Public Const START_SET_YAKIN_COL As Integer = 2       ' 「夜」追加処理判定開始列

Public Const COUNT_YAKIN_WEEKDAY_COL As Integer = 34        ' 平日夜勤日数列
Public Const COUNT_YAKIN_HOLIDAY_COL As Integer = 35        ' 休祝夜勤日数列

' 処理の定数
Public Const MEMBER_LIST_ELEMENTS As Integer = 4        ' メンバ配列の要素数
Public Const MEMBER_LIST_TANTOSYA As Integer = 0        ' メンバ配列の担当者の要素(番目)
Public Const MEMBER_LIST_WEEKDAY As Integer = 1        ' メンバ配列の平日の要素(番目)
Public Const MEMBER_LIST_HOLIDAY As Integer = 2        ' メンバ配列の休日の要素(番目)
Public Const MEMBER_LIST_LASTDAY As Integer = 3        ' メンバ配列の直近夜勤日の要素(番目)

' 文言の定数
Public Const WORD_YAKIN_TANTO As String = "夜"     ' 夜勤担当
Public Const WORD_YAKIN_NG As String = "不"        ' 夜勤不可
Public Const WORD_SATURDAY As String = "土"        ' 土曜日
Public Const WORD_SUNDAY As String = "日"        ' 日曜日
Public Const WORD_HOLIDAY_KYUJITSU As String = "休"        ' 休日
Public Const WORD_HOLIDAY_SHUKUJITSU As String = "祝"        ' 祝日

■サンプルコード

▼表初期化処理

Option Explicit

' 表初期化処理
' 引数      :なし
' 戻り値    :なし
' 処理概要  :①夜勤表の「夜」文字を削除する
'           :②平日、休祝の夜勤日数を削除する
Public Sub Click_InitTable_Btn()

    Dim shtmain     As Worksheet        ' メインシート格納する変数
    Dim irow        As Integer          ' 行カウンタ
    Dim icol        As Integer          ' 列カウンタ

On Error GoTo Click_InitTable_Btn_Error

    ' メインシートをセット
    Set shtmain = Sheets(SHTNAME_MAIN)
    
    ' 初期値をセット
    irow = START_MEMBER_ROW
    icol = START_SET_YAKIN_COL
    
    ' メインシートにフォーカス
    With shtmain
        
        ' メンバ分ループ処理
        Do Until .Cells(irow, START_MEMBER_COL).Value = ""
            
            ' 日付分ループ処理
            Do Until .Cells(DAY_ROW, icol).Value = ""
                
                ' 「夜」の文字が入っていた場合は空白にする
                If .Cells(irow, icol).Value = "夜" Then
                
                    .Cells(irow, icol).Value = ""
                
                End If
                
                ' インクリメント
                icol = icol + 1
            
            Loop
            
            ' 平日/休祝夜勤日数を初期化
            .Cells(irow, COUNT_YAKIN_WEEKDAY_COL).Value = 0
            .Cells(irow, COUNT_YAKIN_HOLIDAY_COL).Value = 0
            
            
            ' インクリメント
            irow = irow + 1
            
            ' 列カウンタ初期化
            icol = START_SET_YAKIN_COL
        
        Loop
    
    
    End With
    
    MsgBox "初期化しました"
    
GoTo Click_InitTable_Btn_Exit


' エラーハンドリング
Click_InitTable_Btn_Error:
    MsgBox Err.Description
    
    GoTo Click_InitTable_Btn_Exit

' 終了処理
Click_InitTable_Btn_Exit:

    ' シート解放
    Set shtmain = Nothing

End Sub

▼夜勤当番表作成処理

Option Explicit

' 夜勤当番作成処理
' 引数      :なし
' 戻り値    :なし
' 処理概要  :①夜勤表に「夜」文字を追加する
'           :②平日、休祝の夜勤日数を追加する
Public Sub Click_Make_YakinToban_Btn()

    Dim shtmain     As Worksheet        ' メインシート格納する変数
    Dim irow        As Integer          ' 行カウンタ
    Dim icol        As Integer          ' 列カウンタ
    Dim interval    As Integer          ' 夜勤間隔日数
    Dim member()    As String           ' メンバ配列
    Dim icount      As Integer          ' メンバ用カウンタ
    Dim dayflg      As Integer          ' 休日祝日フラグ(1:平日、2:休祝)
    Dim yakinflg    As Boolean          ' 夜勤フラグ(当日夜勤がいる:True、いない:False)
    Dim yakincount  As Integer          ' 夜勤回数カウンタ(初期値:99)
    Dim min_yakin_member As Integer     ' 夜勤回数が最も少ないメンバの要素数(初期値:999)
    Dim min_yakin_row As Integer        ' 夜勤回数が最も少ないメンバの行(初期値:999)

On Error GoTo Click_Make_YakinToban_Btn_Error

    ' メインシートをセット
    Set shtmain = Sheets(SHTNAME_MAIN)
    
    ' 各メンバの配列を作成
    member = MakeMemberList(shtmain)
    
    ' メンバ配列に既存の夜勤担当を付与
    member = CountYakinToban(shtmain, member)
    
    ' 初期値をセット
    irow = START_MEMBER_ROW
    icol = START_SET_YAKIN_COL
    icount = 0
    dayflg = MEMBER_LIST_WEEKDAY
    yakinflg = False
    yakincount = 99
    min_yakin_member = 999
    min_yakin_row = 999
    
    ' メインシートにフォーカス
    With shtmain
        ' 夜勤間隔日数を取得する
        interval = .Cells(INTERVAL_YAKIN_ROW, INTERVAL_YAKIN_COL).Value
    
        ' 日付分ループ処理
        Do Until .Cells(DAY_ROW, icol).Value = ""
            
            ' 平日・休祝判定(「休」、「祝」、「土」、「日」なら配列番号を休祝にする)
            If .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_HOLIDAY_KYUJITSU Or _
                .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_HOLIDAY_SHUKUJITSU Or _
                .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_SATURDAY Or _
                .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_SUNDAY _
                Then
                
                ' フラグを休日にする
                dayflg = MEMBER_LIST_HOLIDAY
            
            Else
                ' フラグを平日にする
                dayflg = MEMBER_LIST_WEEKDAY
                
            End If
            
            ' メンバの人数分ループ処理
            Do Until .Cells(irow, START_MEMBER_COL).Value = ""
                
                
                ' あらかじめ入力した「夜」の文字をチェック
                If .Cells(irow, icol).Value = WORD_YAKIN_TANTO Then
                                       
                    ' 夜勤担当者がいれば、フラグを変更
                    yakinflg = True
                    
                    ' メンバ配列の直近夜勤日が空ではない場合
                    If member(icount, MEMBER_LIST_LASTDAY) <> "" Then
                    
                        '「対象日-各メンバ配列の直近日付 <= 夜勤間隔」の場合
                        If CInt(DateDiff("d", CDate(member(icount, MEMBER_LIST_LASTDAY)), .Cells(DAY_ROW, icol).Value)) <= interval Then
                        
                            MsgBox "既存入力の夜勤担当者が夜勤間隔日数内に設定されています" & vbCrLf & _
                                "対象日:" & .Cells(DAY_ROW, icol).Value & vbCrLf & _
                                "夜勤間隔:" & interval & "日" & vbCrLf & _
                                "対象者:" & member(icount, MEMBER_LIST_TANTOSYA)
                                
                             GoTo Click_Make_YakinToban_Btn_Exit
                        End If
                    
                    End If
                    
                    ' 直近夜勤日を対象者のメンバ配列へ入れる
                    member(icount, MEMBER_LIST_LASTDAY) = CStr(.Cells(DAY_ROW, icol).Value)

                End If
                
                ' 夜勤担当者がいない場合のために夜勤数(平日+休日)が1番少ないメンバ情報を保持しておく
                If yakinflg = False Then
                    
                    ' 「不」が記入しているの場合は対象に含めない
                    If .Cells(irow, icol).Value <> WORD_YAKIN_NG Then
                        
                        ' 各メンバ配列の直近日付が空の場合
                        If member(icount, MEMBER_LIST_LASTDAY) = "" Then
                        
                            ' 夜勤回数が最も少ない場合、メンバカウンタと行を保持する
                            If CInt(member(icount, MEMBER_LIST_WEEKDAY)) + CInt(member(icount, MEMBER_LIST_HOLIDAY)) < yakincount Then
                            
                                ' メンバカウンタと行を保持する
                                min_yakin_member = icount
                                min_yakin_row = irow
                            
                                ' 回数をそのメンバの回数に変更
                                yakincount = CInt(member(icount, MEMBER_LIST_WEEKDAY)) + CInt(member(icount, MEMBER_LIST_HOLIDAY))
                            
                            End If
                        
                        ' 各メンバ配列の直近日付が空ではない場合
                        ElseIf member(icount, MEMBER_LIST_LASTDAY) <> "" Then
                            
                            '「対象日-各メンバ配列の直近日付 > 夜勤間隔」の場合
                            If CInt(DateDiff("d", CDate(member(icount, MEMBER_LIST_LASTDAY)), .Cells(DAY_ROW, icol).Value)) > interval _
                            Then
                            
                                ' 夜勤回数が最も少ない場合、メンバカウンタと行を保持する
                                If CInt(member(icount, MEMBER_LIST_WEEKDAY)) + CInt(member(icount, MEMBER_LIST_HOLIDAY)) < yakincount Then
                            
                                    ' メンバカウンタと行を保持する
                                    min_yakin_member = icount
                                    min_yakin_row = irow
                            
                                    ' 夜勤回数を対象(最小回数)メンバの回数に変更
                                    yakincount = CInt(member(icount, MEMBER_LIST_WEEKDAY)) + CInt(member(icount, MEMBER_LIST_HOLIDAY))
                            
                                End If
                            End If
                            
                        End If
                    
                    End If
                
                End If
                
                ' インクリメント
                irow = irow + 1
                icount = icount + 1
            
            Loop
            
            ' 当日夜勤者がいなければ最も夜勤数が少ない人へ夜勤を割り当てる
            If yakinflg = False Then
            
                ' 夜勤可能者がいない場合はエラー
                If min_yakin_row = 999 Or min_yakin_member = 999 Then
                    
                    MsgBox "夜勤可能な人がいません" & vbCrLf & _
                        "対象日:" & .Cells(DAY_ROW, icol).Value & vbCrLf & _
                        "夜勤間隔:" & interval & "日"
                    
                    GoTo Click_Make_YakinToban_Btn_Exit
                Else
                
                    ' 「夜」の文字を出力
                    .Cells(min_yakin_row, icol).Value = WORD_YAKIN_TANTO
                
                    ' メンバの配列に加算
                    member(min_yakin_member, dayflg) = Val(CInt(member(min_yakin_member, dayflg)) + 1)
                    
                    ' 直近夜勤日を対象者のメンバ配列へ入れる
                    member(min_yakin_member, MEMBER_LIST_LASTDAY) = CStr(.Cells(DAY_ROW, icol).Value)
                End If
            
            End If
            
            ' インクリメントと初期化
            icol = icol + 1
            irow = START_MEMBER_ROW
            icount = 0
            yakinflg = False
            yakincount = 99
            min_yakin_member = 999
            min_yakin_row = 999
        
        Loop
        
        ' 初期化処理
        irow = START_MEMBER_ROW
        icount = 0
        
        ' メンバ数分ループ
        Do Until .Cells(irow, START_MEMBER_COL).Value = ""
        
            ' 各メンバの平日/休祝夜勤日数をセットする
            .Cells(irow, COUNT_YAKIN_WEEKDAY_COL).Value = member(icount, MEMBER_LIST_WEEKDAY)
            .Cells(irow, COUNT_YAKIN_HOLIDAY_COL).Value = member(icount, MEMBER_LIST_HOLIDAY)
        
            ' インクリメント
            irow = irow + 1
            icount = icount + 1
        
        Loop
    
    End With
    
    MsgBox "完了"
    
    GoTo Click_Make_YakinToban_Btn_Exit


Click_Make_YakinToban_Btn_Error:
    
    MsgBox Err.Description & vbCrLf

    GoTo Click_Make_YakinToban_Btn_Exit


Click_Make_YakinToban_Btn_Exit:

    ' メインシートを解放
    Set shtmain = Nothing

End Sub


▼各メンバ配列作成処理

Option Explicit

' メンバ配列作成処理
' 引数      :シート名
' 戻り値    :2次元配列([メンバ1, 平日日数, 休日日数, 直近夜勤日],[メンバ2, 平日日数, 休日日数, 直近夜勤日]・・・ )
' 処理概要  :①メンバの数だけ配列要素を作成
'           :②平日、休祝の夜勤日数(初期値0日)をセット
Public Function MakeMemberList(shtname As Worksheet) As String()
    
    Dim memberlist()    As String  ' 戻り値用の配列
    Dim irow        As Integer  ' 行カウンタ
    Dim membercount           As Integer  ' 配列用メンバ数
    Dim i   As Integer
        
    ' 初期値をセット
    irow = START_MEMBER_ROW
    i = 0

    ' メンバ数カウント処理
    membercount = getCountMember(shtname)
    
    ' メンバ分の2次元配列を作成[[メンバ1, 平日日数, 休日日数, 直近夜勤日], ・・・]
    ReDim Preserve memberlist(membercount - 1, MEMBER_LIST_ELEMENTS - 1)
      
    ' 対象のシートにフォーカス
    With shtname
        
        ' 夜勤表のメンバ数分繰り返す
        Do Until .Cells(irow, START_MEMBER_COL).Value = ""
        
            ' メンバ名、平日夜勤日数、休祝夜勤日数、直近夜勤日をセット(直近の夜勤日は空)
            memberlist(i, 0) = .Cells(irow, START_MEMBER_COL).Value
            memberlist(i, 1) = "0"
            memberlist(i, 2) = "0"
            memberlist(i, 3) = ""
                       
            ' インクリメント
            irow = irow + 1
            i = i + 1
            
        Loop
        
    End With

    ' 戻り値を設定
    MakeMemberList = memberlist()


End Function

▼メンバ数カウント処理

Option Explicit
 
' メンバ数を数えるファンクション
Private Function getCountMember(shtname As Worksheet) As Integer

    Dim irow As Integer          ' 行カウンタ
    Dim i As Integer                ' 人数カウンタ
    
    ' 初期値をセット
    irow = START_MEMBER_ROW
    i = 0
    
    With shtname
        
        ' 夜勤表のメンバ数分繰り返す
        Do Until .Cells(irow, START_MEMBER_COL).Value = ""
            ' インクリメント処理
            i = i + 1
            irow = irow + 1
        Loop
        
    End With
    
    ' 戻り値を返す(加算した人数)
    getCountMember = i

End Function

▼事前夜勤当番加算処理

Option Explicit

' あらかじめ設定している夜勤当番を配列に加算するファンクション
Public Function CountYakinToban(shtname As Worksheet, memberlist() As String) As String()

    Dim irow As Integer ' 行カウンタ
    Dim icol As Integer ' 列カウンタ
    Dim icount As Integer ' メンバ配列要素用カウンタ
    Dim dayflg      As Integer          ' 休日祝日フラグ(1:平日、2:休祝)
    
    ' 初期値を設定
    irow = START_MEMBER_ROW
    icol = START_SET_YAKIN_COL
    icount = 0
    dayflg = 1
    
    ' シートにフォーカス
    With shtname
    
        ' メンバ分ループ処理
        Do Until .Cells(irow, START_MEMBER_COL).Value = ""
            ' 日数分ループ処理
            Do Until .Cells(DAY_ROW, icol).Value = ""
                
                ' 平日・休祝判定(「休」、「祝」、「土」、「日」なら配列番号を休祝にする)
                If .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_HOLIDAY_KYUJITSU Or _
                    .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_HOLIDAY_SHUKUJITSU Or _
                    .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_SATURDAY Or _
                    .Cells(DAY_OF_WEEK_ROW, icol).Value = WORD_SUNDAY _
                    Then
                
                    dayflg = MEMBER_LIST_HOLIDAY
            
                Else
                    dayflg = MEMBER_LIST_WEEKDAY
                
                End If
                
                
                ' 「夜」を入力していたら、メンバ配列に加算する
                If .Cells(irow, icol).Value = WORD_YAKIN_TANTO Then
                    
                    ' メンバの配列に加算
                    memberlist(icount, dayflg) = Val(CInt(memberlist(icount, dayflg)) + 1)
                    
                End If
            
                ' インクリメント
                icol = icol + 1
            
            Loop
            
        
            ' インクリメントと初期化
            irow = irow + 1
            icount = icount + 1
            icol = START_SET_YAKIN_COL
            
        Loop
    
    End With

    ' 戻り値の設定
    CountYakinToban = memberlist()

End Function

■実行結果

▼表初期化処理

・「初期化」ボタン押下前

・「初期化」ボタン押下後

▼夜勤当番表作成処理

・正常系

・「夜勤割り当て」ボタン押下前
夜勤間隔日数:4日とし、任意のメンバの日付に「夜」を付与。

・「夜勤割り当て」ボタン押下後

・異常系

・夜勤担当可能者がいない場合(4/8:全員「不」)


・夜勤間隔日数(4日に設定)内に連続して同じ夜勤者がいる場合(A君:4/8、4/9)

コメント

タイトルとURLをコピーしました