シフト作成をしないといけません。立証数を同じくしたいのですが、うまくいきません。

Question

シフト作成をしないといけません。立証数を同じくしたいのですが、うまくいきません。条件は貼り付けた画像の中にあります。
立証数を同じくするシフト作成ツールありませんか?

Answer 1

画像の表を例として 立哨 のシフトを作成します。
午前中に3連続を作りすぎてしまうと14時に4人を確保できなくなるので、午前中は作らないようにしています。
立哨回数はチェックしていませんが、あまり差がない回数になるようです。
待機の条件がわからないので、すべての時間に割り振っています。

Sub 立哨シフト表()
人数 = Range(Range("B6"), Range("B6").End(xlDown)).Rows.Count
区分 = "AM"
RE_START_0:
If 区分 = "AM" Then
Range("C6:X11").ClearContents
連続回数 = 2
開始 = 1
終了 = 11
ElseIf 区分 = "PM" Then
Range("Q6:X11").ClearContents
連続回数 = 3
開始 = 15
終了 = 22
End If
For J = 開始 To 終了
For I = 1 To 人数
Randomize
Range("C22").Offset(I - 1) = Rnd
Next
補正 = 0
RE_START_1:
所要人数 = Range("C6").Offset(-4, J - 1)
For I = 1 To 人数
乱数 = Range("C22").Offset(I - 1)
If Range("C6").Offset(I - 1, J - 1) <> "×" Then
If WorksheetFunction.Rank(乱数, Range("C22").Resize(人数), I) <= 所要人数 + 補正 Then
CHK = WorksheetFunction.CountIf(Range("C6").Offset(, J - 1).Resize(人数), "○")
If CHK < 所要人数 Then
Range("C6").Offset(I - 1, J - 1) = "○"
GoSub 立哨連続
End If
End If
End If
Next
CHK = WorksheetFunction.CountIf(Range("C6").Offset(, J - 1).Resize(人数), "○")
補正 = WorksheetFunction.CountIf(Range("C6").Offset(, J - 1).Resize(人数), "×")
If CHK <> 所要人数 Then
DoEvents
For I = 1 To 人数
If Range("C6").Offset(I - 1, J - 1) = "○" Then
If J <> 10 Then
Range("C6").Offset(I - 1, J - 1).ClearContents
Else
Range("C6").Offset(I - 1, J - 1).Resize(, 3).ClearContents
End If
End If
Next
If 人数 - 補正 >= 所要人数 Then
GoSub 立哨連続
GoTo RE_START_1
Else
GoTo RE_START_0
End If
End If
Next
If 区分 = "AM" Then
Range("M6").Resize(人数).Copy
Range("N6").PasteSpecial Paste:=xlValues
For I = 1 To 人数
If Range("N6").Offset(I - 1) = "○" Then
Range("N6").Offset(I - 1, 1).ClearContents
Else
Range("N6").Offset(I - 1, 1) = "○"
End If
Next
Range("O6").Resize(人数).Copy
Range("P6").PasteSpecial Paste:=xlValues
End If
For Each Rng In Range("C6:X11")
If Rng = "×" Then
Rng.ClearContents
End If
Next
If 区分 = "AM" Then
区分 = "PM"
GoTo RE_START_0
End If
Range("A1").Select
Exit Sub
立哨連続:
If 区分 = "PM" And J >= 終了 Then Return
CHK_FLG = ""
For P = 1 To J - 1
If Range("C6").Offset(I - 1, P - 1) = "×" Then
CHK_FLG = CHK_FLG & "×"
ElseIf Range("C6").Offset(I - 1, P - 1) = "○" Then
CHK_FLG = CHK_FLG & 1
Else
CHK_FLG = CHK_FLG & 0
End If
Next
Range("C6").Offset(I - 1, P - 1).Select
If J <> 10 Then
If InStr(CHK_FLG, "×") <> 0 Then
If Right(CHK_FLG, 1) = "1" Then
Range("C6").Offset(I - 1, J) = "×"
End If
Else
If Right(CHK_FLG, 連続回数 - 1) = String(連続回数 - 1, "1") Then
Range("C6").Offset(I - 1, J) = "×"
End If
End If
Else
If InStr(CHK_FLG, "×") <> 0 Then
Range("C6").Offset(I - 1, J) = "×"
Else
If Right(CHK_FLG, 連続回数 - 1) = String(連続回数 - 1, "1") Then
Range("C6").Offset(I - 1, J - 1) = "×"
End If
End If
End If
Return
End Sub

Answer 2

>立証数を同じくするシフト作成ツールありませんか?

そのような物は基本的にロジックを組み行う物なので、それを行うためだけの専用のツールという物はありません。

なので、自身でできなければ発注を行うべき物になります。