多人多条件限制，随机生成排班表并固定

秦玉玺

项目和销售人员较多，排班一直耗费精力，希望有大神能给与帮助，万分感谢。

具体需求请看附件，谢谢

liulang0808

本月31天，每天休息两人，那么合计休息人次是62
这段话理解不了，←$B$32的数字可以修改，但是不超过10（也就是一个月休息不超过10天）
一共10人，每人每月只能休息3-6天，最多休息6天，合计最多休息人次10*6=60,跟上面的62有出入的，不知道理解对不对啊

秦玉玺

liulang0808 发表于 2023-12-24 07:09
本月31天，每天休息两人，那么合计休息人次是62
这段话理解不了，←$B$32的数字可以修改，但是不超过10（ ...

不超过10这个我写的不严谨，您说的对，每个月每个人休息一般在3-6天内；

秦玉玺

liulang0808 发表于 2023-12-24 07:09
本月31天，每天休息两人，那么合计休息人次是62
这段话理解不了，←$B$32的数字可以修改，但是不超过10（ ...

关于每天休息人数不超过2人，也是我考虑不周，应该是在10人团队的话，一天2人，62人次，是在范围内的。假如说20人，一人休息4天，一天需要2-3人休息。优先考虑20人团队，一人一月4天休息，80人次满足后，除以月天数来决定每天最多休息不超过几个人。

蓝桥玄霜

随机排班的例子：
需求5要改为手动修改。

秦玉玺

蓝桥玄霜 发表于 2023-12-25 14:17
随机排班的例子：
需求5要改为手动修改。

老师您好，就是 需求3，一个月一个人休息天数限制，不管改多少都没有什么变化。 比如我修改为3 6，小张1一个月只有1天休息，应该是至少有3天休息，也就是说3、4、5天休息都可以，但不低于3天休息。麻烦老师再看看，谢谢老师

蓝桥玄霜

是不是有抄错的地方，我这里是正确的。因为代码是按最低3天（休息天数的下限）设置的，而且每个人的休息天数都是随机的，有的4天、有的5天。

秦玉玺

蓝桥玄霜 发表于 2023-12-26 09:35
是不是有抄错的地方，我这里是正确的。因为代码是按最低3天（休息天数的下限）设置的，而且每个人的休息天 ...

Sub lqxs()
Dim Arr, i&, Brr, m%, j%
Dim d As Object, k, dX
Dim xx%, zb1%, zb2%, yx1%, yx2%, ts%, bc, sjs%, sj%
Set d = CreateObject("Scripting.Dictionary")
Set dX = CreateObject("Scripting.Dictionary")
Sheet1.Activate
xx = [b32].Value    '同一天休息人数限制
zb1 = [b33].Value: zb2 = [c33].Value    '同一天早班人数限制
yx1 = [b34].Value: yx2 = [c34].Value    '一个月一个人休息天数限制
ts = [b35].Value                        '本月天数
bc = [b36].Resize(1, 3)                 '班次设置

[b20:af29].ClearContents
Randomize
Arr = [a19:a29]
For i = 2 To UBound(Arr)
sjs = Int(Rnd * (yx2 - yx1 + 1)) + yx1 '生成一个月一个人休息天数
Do
sj = Int(Rnd * ts) + 1
If Not d.exists(sj) Then
If d.Count = 0 Then
If dX(sj) < xx Then dX(sj) = dX(sj) + 1 Else GoTo 100
d(sj) = w: k = dkeys
Else
For j = 0 To UBound(k)
If sj <= k(j) + 3 And sj >= k(j) - 3 Then GoTo 100
Next
If dX(sj) < xx Then dX(sj) = dX(sj) + 1 Else GoTo 100
d(sj) = "": k = d.keys
End If
End If
100:
Loop While d.Count < sis
k = d.keys
For j = 0 To UBound(k)
    Cells(i + 18, k(j) + 1) = "休"
Next
d.RemoveAll
Next
Arr = [a18].CurrentRegion
For j = 2 To UBound(Arr, 2)
m = 19: [aj:ak].ClearContents
n = Int(Rnd * (zb2 - zb1 + 1)) + zb1 '生成随机早班人数
For i = 3 To UBound(Arr)
If Arr(i, j) = "" Then
m = m + 1: Cells(m, 36) = i: Cells(m, 37) = "=rand()"
End If
Next
[aj20].CurrentRegion.Sort [ak20], 1, Header:=xlNo
Brr = [aj20].Resize(n, 1)
For i = 1 To UBound(Brr)
Cells(Brr(i, 1) + 17, j) = "早"
Next
For i = 3 To UBound(Arr)
If Cells(i + 17, j) = "" Then Cells(i + 17, j) = "晚"
Next
Next
End Sub

秦玉玺

蓝桥玄霜 发表于 2023-12-26 09:35
是不是有抄错的地方，我这里是正确的。因为代码是按最低3天（休息天数的下限）设置的，而且每个人的休息天 ...

老师麻烦来个附件看看吧，我检查了一下没发现哪里错了，就是每个月每个人就一天休息，还有就是早班会出现连续7天以上的情况

蓝桥玄霜

d(sj) = w: k = dkeys
应该是：
d(sj) = "": k = d.keys
连续早班或者晚班的问题待后续，目前需要手动调整。