これまで３回に渡って改良してきた勤務表自動作成ツールですが、今回の記事で完全版としたいと考えています。
前回の記事は二次元配列を使うことで高速化したというのがメインでしたが、それ以外に夜勤の労働数や遅出の翌日は早出禁止といった条件をセルの値を変えることで切り替えられる仕様にしていました。
これは考えうるニーズのある機能を埋め込んでおいて、ユーザーが任意で使うか使わないかを簡単に切り替えられるというユーザー目線の仕様でした。
ただ、多機能にしようと思えばいくらでもできてしまうのでキリがありません。多機能にすると操作や設定が複雑になって使いにくいものになってしまいます。
それでも使用するユーザーが多いのであれば、知識のないユーザーが自由に設定を切り替えられるのは便利です。逆に使用するユーザーが限定されるのであれば、機能を最低限にして開発者が特定のユーザー向けにカスタマイズする方が合理的だと考えました。
というわけで、この完全版では開発者が任意でカスタマイズしやすいようにコードを整理しました。
追記: 完全版と言いながらさらなる改良版を作りました。
プログラムの内容
こちらがサンプルデータです。
勤務表本体部分と、下に日別の集計、右側に人別の集計、さらにその右に自動作成用の設定があります。
勤務表は入力規則によってドロップダウンで選択できるようにしています。
集計は１列・行目の文字列をCOUNTIFで数え、２列・行目の数字未満であれば赤くハイライトするよう条件付き書式を設定しています。
なお、前回まで選択しているセルの職員と日付がハイライトされるようにしていましたが、動作が重たくなるので今回は設定していません。
新規シート作成
[新規]ボタンを押すと年月を入力するフォームが出てきます。選択式にすることで分岐を減らせますし、何よりユーザーの入力が楽になります。
西暦は現在の年と前後１年を選択できるようにしています。
この西暦と月から１ヶ月の日数と曜日を取得して自動的に設定し、新規シートを作成します。
実際には[新規]ボタンを押した時のアクティブシートを複製して、勤務表の中身をクリアして日付と曜日を設定し直しているだけです。
職員追加
[追加]ボタンを押すと職員名を入力するウィンドウが出てきます。
これで勤務表の最終行に追加されます。
これだけなら行追加でやってもそれほど労力はかからないのですが、その場合の問題は下の集計です。
単に行追加しただけではCOUNTIFの数式の参照が変わらず、追加した行が集計されません。このボタンから追加を行うことで、中の数式も更新しています。
自動入力
肝となる部分です。事前準備として、希望休や勤務の予定が決まっていればあらかじめ入力しておきます。
自動入力はランダムでセルを選択し、空白セルに対して入力していきます。何かしらの値が入っているセルは対象外になります。
そして設定の部分ですが、夜・公休・早・遅の４つのシフトを入力します。この並びで順番に処理が行われます。
それぞれの要件は以下の通りです。
| 夜 | １労働の夜勤で、基本的に連続夜勤でその後は連続休み。 連続にならなかった場合は翌日休み。 |
| 公休 | 月によって日数が変化。31日の月は10日、28日の月は8日、それ以外は9日。 ５連勤以上にならないようにする。 |
| 早 | 遅出の次の日は早出にならないようにする。 |
| 遅 | 早出の前日は遅出にならないようにする。 |
１行目の文字列が入力され、２行目は設定する回数です。夜・早・遅は１日あたりの人数で、公休は１ヶ月あたりの回数です。公休については勤務表の日付の入力から自動的に値が変わるように関数を埋め込んでいます。
今回の設定では夜勤は１人、早出と遅出が２人ずつ、６月は30日までなので公休は９日設定されます。
各職員の行は自動入力するか否かを設定でき、0ならオフ、1ならオンです。公休は1なら常勤、0なら非常勤とみなされます。
設定が確認できたら[入力]ボタンを押します。
二次元配列内で処理をして最後にシートへ貼り付けているのでほとんど時間がかからず完了します。セルの背景色はあらかじめ条件付き書式で設定されています。
設定通り入力されますが、職員数が少なかったりあらかじめ入力されていた予定が多いと設定の人数や回数に満たない場合もあります。集計で数が合っているか確認します。
空白置換
自動入力後の調整は自由です。ここでめんどくさいのは空白セルの処置。１つずつ埋めるのは大変です。
[置換]ボタンを押すと、常勤職員は「日」、非常勤職員は「休」が空白セルに入ります。常勤と非常勤の判定は公休の列で行います。
これで勤務表の完成という流れです。
コード
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) '且つ３日後が空白か休みならセット
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各ボタンのプロシージャは下記の通り。
| ボタン | プロシージャ |
|---|---|
| 新規 | 新規シート |
| 追加 | 職員追加 |
| 入力 | 自動入力 |
| 置換 | 空白置換 |
そして繰り返し同じ記述が必要な部分についてはプロシージャでまとめています。
| レイアウト設定 | 参照する行・列番号を設定 |
| 人数カウント | １日に対して既に入力されている数をカウント |
| シャッフル | 配列の順番をランダムに入れ替える |
今回の主な変更点は夜→公休→早→遅という流れを、ループの変数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フォーム内のプロシージャは以下の３つです。
| UserForm_Initialize | フォームを開いた際に年月の値を作成 |
| CommandButtonOK_Click | 実行ボタンクリック時の処理 |
| CommandButtonCancel_Click | キャンセルボタンクリック時の処理 |
そしてフォーム内のコンボボックスとボタンには下記のオブジェクト名があてられています。
| 年 | ComboBoxYear |
| 月 | ComboBoxMonth |
| 実行ボタン | CommandButtonOK |
| キャンセルボタン | CommandButtonCancel |
コメント
こちらのシフト自動作成マクロ、使用させていただいております。大変便利でとても感謝しております。
1つご質問ですが、夜勤が2日連続にならないようにする為にはどこのコードを書き換えばいいのでしょうか？
ご教授頂けると幸いです。
コメントありがとうございました。お褒めいただき恐縮です。
168行目～208行目が連続夜勤にする処理なので、この範囲を消せば連続の処理にはなりません。
ただし、この処理の中で夜勤の翌日を休みにする処理も行っているので注意してください。
ご返信ありがとうございます。
追加でご質問なのですが、「夜勤のあと5日間休み」という処理をさせたいのですが、どのようにすれば良いのでしょうか？
206行目で翌日休みの処理を行っていますが、5日分ループしてください。
配列のサイズを超える処理をしようとするとエラーが出るので注意してください。
例えば、30日の月であれば26日夜勤として27日以降5日間休みとすると、存在しない31日まで入力しようとします。配列は30日の分までしか用意していないのでエラーとなります。
ループの中で199行目や201行目、配列の最後まで到達していればループを抜けるという条件分岐を記述してください。
毎度、ご丁寧にありがとうございます。
私はVBAの知識を深く持ち合わせておりませんので、自分でプログラムを書くことができません！申し訳ないです…
少しずつ勉強してみようと思います！教えていただきありがとうございます！
ぜひ本やネットで調べながら挑戦してみてください^^
1日当たりの勤務人数をシフトパターン1～6パターン、各1名ずつ配置したいのですが
どこの記述を変更すればよいのかわかりません。教えていただけると助かります。
コメントありがとうございます。
人数については表の値を変えることで設定できます。
パターンごとの処理ですが、サンプルでは夜→公休→早→遅という流れを、ループの変数iの値0→1→2→3で表してSelect Caseでそれぞれの処理を独立させています。
つまり設定の表に２列追加して、ループの変数iを0～5にすればシフトパターンを６まで増やせます。
あとはSelect Caseで各パターンの処理を変えればOKです。
個人ごとの夜勤や早出の回数を月単位でできるだけ均等に割り当てをしたいのですが、
どのように記述すればよいでしょうか。ご教授いただけると幸いです。
配置の順番はランダムではありますが、必ず配置の順番は均等に回ってきますので、予定が全く無い状態では極めて均等と言えます。
配置の順番が回ってきたところに予定が入っていると次の周回まで待つ必要があり、そこで均等さが欠けてきます。
その対策としては、予定が入っていて配置ができなかった人をリザーブしておく配列を用意し、まずはその配列に入っている人から配置していくという風にすれば均等になりやすいのではないかと思います。
あるいは、夜勤や早出の上限回数を決めて、その回数を超えないように配置するという方法もありますが、これは配置ができない日が出てくると思います。
はじめまして！
VBAが皆無の私ですが仕事効率を上げる為、こちらのデータを使わせていただきたいと思っております。
、、、本当に初期の段階で申し訳ないのですがこちらをコピペさせていただいた際、
private sub レイアウト設定()が黄色くなり、
コンパイルエラー:変数が定義させていません。と表示され、
i = headRow のi=が青くなります。
原因を教えていただけないでしょうか。
はじめまして！
勤務表の作成に困っており、こちらのサイトに出会いました！
VBA皆無の私ですが仕事効率を上げる為、
調べながらこちらのデータを使わせていただきたいと思っております。
早速ですがコピペをしてみたところ
コンパイルエラー:変数が定義させていません。
i = headRow→i=が青くなり
その上にある
Private Sub レイアウト設定()→黄色くなりました。
iの定義はどうすれば良いのでしょうか。
そもそもVBAのコピペの仕方がまずいのでしょうか、、
申し訳ないのですが教えていただけると嬉しいです。よろしくお願いします、、。
コメントありがとうございます。
おそらく変数宣言を強制しているのではないかと思います。
確かに変数iについては宣言しておらず、宣言しなくても基本的に動くのがVBAなのですが、宣言を強制している場合はエラーが出ます。
コードをコピペしたと仰っておりますが、冒頭に「Option Explicit」という一文はありませんか？
その一文がありましたその行を削除するか、あるいは変数iを宣言してください。整数型で宣言すれば問題なく動くかと思います。
早速のご返答ありがとうございます！
たしかに上に表記がありました。。
調べてみたらチェックがかかっていたようで宣言強制を外したところ無くなりました。
ありがとうございます！
ですが次に実行時エラー1004で
アプリケーション定義またはオブジェクト定義のエラーです。との表示があり、
デバッグをしてみると
サイト上の29行目
Do While Cells(i,headCol).Value=””
が黄色くなります、、。
こちらはどのような原因が考えられますでしょうか。
お手数ですがご返答いただけると幸いです。
そのご説明だけでは不具合を特定できませんが、おそらくExcelのシートのレイアウトがマクロに対して適したものになっていないのだと思います。
29行目は日別集計の表を探すループでして、勤務表の下に「夜」「早」「遅」「日」と書かれた表があり、その表の開始行を探すのが目的です。
職員名が記された最終行を取得後、次に空白じゃないセルが見つかったらそこを日別集計の表の開始行と判断するようにしています。
おそらく日別集計の表を作っておられないのではないかと推測します。
このVBAはサンプルで作成したシートのレイアウトに合うように作っていますので、アレンジされる場合でもコードと各オブジェクトの関係を分析されることをおすすめします。
こちらのシフト自動作成マクロを使用させていただいております。
すごくわかりやすく、コードにコメントが多くあり感謝しております。
質問のですが、夜勤、早出、遅出の次の日を『非番又は空白』で返すことで悩んでおります。夜勤は前後を休みか空白にできましたが、早出と遅出で難航しております
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
という文に変えましたが、思いのほかうまく作動できませんでした。
ご教授頂けると幸いです。
コメントありがとうございます。
うまく作動しないというのがどういう状況なのかがわかりません。
エラーで中止してしまうのか、前日または翌日が空白であっても入力されてしまうのかといったことを詳細に教えてください。
夜勤でうまくいったのであれば同じやり方を早や遅でやればできるはずです。デバッグモードで変数の中身や処理の状況を確認したら解決できるかと思います。
返信ありがとうございます。
困っていることが２つあります。
一つ目は
夜勤のあとに公休などが入力されているためか、早出や遅出がセットされません。
この場合、Case 0～3の内容の順序変更すればいいのでしょうか？
二つ目は
If c = kinmuTable(r, c – 1) = “” And UBound(kinmuTable, 2) Then
’前日が空白で最終日ならセット
等とするとインデックスエラーが発生します。
そのため最終日なら前日が仕事の日でも最終日に仕事がセットされてしまいます。
お手数をおかけして申し訳ございませんが、よろしくお願いいたします。
1つ目については、夜勤の翌日は公休が入力される仕様なので、翌日に公休が入力されないように変更するか、仰るように入力の順番を変えてください。
2つ目については、前日が仕事の日でも最終日に仕事がセットされることがおかしいのではなく、インデックスエラーが発生するのであれば処理が中止されて困っているということですね。
そのIf文はAndの後ろの書き方が間違っているのですが、それだと別のエラーが出るのでおそらくこのコメントに書く段階で間違ったものだと解釈します。
インデックスエラーということは配列の指定の仕方が間違っているのだと思います。最初にいただいたコメントではElse Ifで分岐していて回避できているかと思いましたが、その書き方ですとcが0の時にkinmuTableの二次元目のインデックスは-1を参照するのでエラーになります。
エラーにならないようにさらに分岐させてください。