一个多维排班问题

zhenkai

各位大咖，马上就要到2025年了，公司由于提升了一位中层干部，使值班总人数为28人，这样循环排班就导致很多人总值六日的班，有失公平，现在想换个排版规则，使排班更加公平。

简单介绍下。一共有28人需要值班，每天1个人，28人有9人是领导，有19人是中层。法定节假日只领导值，平日和休息日是所有人循环排。法定节假日是从8：30值到次日8：30，平日是17：00-20：00，休息日是8：30-20：00。自从增加1名中层干部以后，我们想了各种方法去排都不能很好的均衡节假日、休息日和平日，在网上找了排班软件，虽然能够均衡一些，但是找不到规律，无法给别人讲清楚，很随机。我是想有没有一种算法或者规律，首先保障节假日领导相对均衡，然后再保障休息日，最后平日，然后总体上所有班次加起来也比较均衡，每人值班次数相差不大。而且我们采用车轮式，先把节假日循环排出来，再对休息日平日排，有时会出现一个月里面有的人值2-3次，但是还有的人会轮空。如何避免这中情况出现。
谢谢大家
附件是一个排班表，有日期，分类和人员名单，请帮忙像个办法排一排。谢谢大家

翁知江安

Sub paiban()
Dim i, j, k, kk, kkk, kkkk, pp, z, zz, aa, q, qq, m, n, p, b, bb, xx, yy, x, y, irow, irow1
Dim ar, br, cr, dr, er
Dim d1, d2 As Object
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
irow1 = Sheets("人员").[a1000].End(xlUp).Row
For i = 2 To 10
   d1(i - 1) = Sheets("人员").Cells(i, 1)
Next
For i = 11 To irow1
   d2(i - 10) = Sheets("人员").Cells(i, 1)
Next

irow = Sheets("排班表").[a1000].End(xlUp).Row
ar = Sheets("排班表").Range("a1:d" & irow)
ReDim br(1 To irow - 1, 1 To 5)
ReDim cr(1 To irow - 1, 1 To 5)
ReDim dr(1 To irow - 1, 1 To 5)
For j = 2 To irow
   ar(i, 1) = Format(ar(i, 1), "yyyy/mm/dd")
   ar(i, 2) = WorksheetFunction.Text(ar(i, 2), "aaaa")
  If ar(j, 3) = "节假日" Then
    m = m + 1
    br(m, 1) = j
    For p = 2 To 5
    br(m, p) = ar(j, p - 1)
    Next
    Else
    If ar(j, 3) = "平日" Then
      n = n + 1
      cr(n, 1) = j
      For p = 2 To 5
      cr(n, p) = ar(j, p - 1)
      Next
      Else
      q = q + 1
      dr(q, 1) = j
      For p = 2 To 5
      dr(q, p) = ar(j, p - 1)
      Next
    End If
End If
Next
Sheets("排班表").[f1].Resize(500, 5).ClearContents
k = WorksheetFunction.RandBetween(1, d1.Count)
br(1, 5) = d1((k - 1) Mod 9 + 1)
For x = 2 To m
   xx = xx + 1
   br(x, 5) = d1((k + xx - 1) Mod 9 + 1)
Next

If n >= 19 Then
kk = WorksheetFunction.RandBetween(1, d2.Count)
cr(1, 5) = d2((kk - 1) Mod 19 + 1)
For y = 2 To Int(n / 19) * 19
   yy = yy + 1
   cr(y, 5) = d2((kk + yy - 1) Mod 19 + 1)
Next
End If

If q >= 19 Then
kkk = WorksheetFunction.RandBetween(1, d2.Count)
dr(1, 5) = d2((kkk - 1) Mod 19 + 1)
For z = 2 To Int(q / 19) * 19
   zz = zz + 1
   dr(z, 5) = d2((kkk + zz - 1) Mod 19 + 1)
Next
End If

ReDim er(1 To irow - 1, 1 To 5)
For pp = 1 To n
  If cr(pp, 5) = "" Then
    qq = qq + 1
    For aa = 1 To 4
    er(qq, aa) = cr(pp, aa)
    cr(pp, aa) = ""
    Next
  End If
Next
For pp = 1 To q
  If dr(pp, 5) = "" Then
    qq = qq + 1
    For aa = 1 To 4
    er(qq, aa) = dr(pp, aa)
    dr(pp, aa) = ""
    Next
  End If
Next

kkkk = WorksheetFunction.RandBetween(1, d2.Count)
er(1, 5) = d2((kkkk - 1) Mod 19 + 1)
For b = 2 To qq
   bb = bb + 1
   er(b, 5) = d2((kkkk + bb - 1) Mod 19 + 1)
Next

With Sheets("排班表")
.[a1].Resize(1, 4).Copy Sheets("排班表").[g1]
.[f2].Resize(m, 5) = br
.Cells(m + 2, 6).Resize(Int(n / 19) * 19, 5) = cr
.Cells(m + Int(n / 19) * 19 + 2, 6).Resize(Int(q / 19) * 19, 5) = dr
.Cells(m + Int(n / 19) * 19 + Int(q / 19) * 19 + 2, 6).Resize(qq, 5) = er
.[f1].Resize(irow + 1, 5).Sort key1:=Columns("f"), order1:=xlAscending, Header:=xlYes
End With
End Sub

翁知江安

以上只是个人的一些推测，供参考。程序设计时，主要考虑值班频次和值班时长，目标是值班人员只能做到大致公平。

翁知江安

为此还添加了验算程序，供参考。

翁知江安

以上个人理解，欢迎批评指正。

zhenkai

翁知江安 发表于 2024-12-21 09:57
以上个人理解，欢迎批评指正。

非常感谢您测算回复，有一个问题是我看给休息日只安排的中层值，这个是不对的，休息日和平日都是中层+领导一起轮着值，只有法定节假日是领导值。
我一直也在算，考虑的第一个是 法定节假日领导单独排，9个人，28个节假日，有一个领导多一天，这个无所谓。然后就是排休息日和平日，如果不区分休息日和平日的区别一起混排的话，因为是28个人可以被7整除，就会有很多人总值休息日的班。我现在采用的方法是第一周期值完，第二周期错后两个人，第三个周期再错后2个人，这样就出现一些月份有的人轮空，有的人值2次或3次。

如果休息日也拿出来单独排的话，轮空的人数或重复值的人数会更多。
想不出好办法，谢谢您

dambcer

供参考。。。。。。。。。。。。。。

笨鸟飞不高

参考！

笨鸟飞不高

zhenkai

dambcer 发表于 2024-12-21 12:50
供参考。。。。。。。。。。。。。。

谢谢您关注