本文于2023年10月1日首发于本人同名公众号，更多文章案例请搜索关注！
内容提要
排班表
值班统计表
大家好，我是冷水泡茶，今天在EXCELHOME论坛上看到一个求助贴，
[求助] 这个值班表做起来有难度
他的要求是“8人值班，但1人要固定（比如王五）在周三值班，另1人要固定（比如于东）在周六值班，其他人6人按顺序轮流值班，如何排班？“
我们再看看他的数据表：
经过仔细分析，觉得他的这个表的设计可以调整一下，在右上人员及统计区域，我们增加一栏“备注”，填写固定值班人员的星期信息，这样写代码要容易一点，同时，今后有什么调整，也很方便。右下循环值班人员就不要了，我们可以在代码中生成。
另外，他这个月份是一个下拉列表，1-12月，我想他的用意是选择月份，对应统计该人员的当月值班次数据及累计值班次数。
花了点时候做了一下，分享给大家：
基本思路
1、把左边的排班明细信息装入数组arr，把右边的人员及统计信息装入数组arrRef。
2、循环arrRef，把非固定星期几值班的人员写入数组arrRnd。
3、循环两个数组，如果碰到固定日期，则把对应的人员填入arr，否则就顺序填入非固定人员。
3、把arr数据回写到工作表。
4、统计月度、累计值班次数。
VBA代码
1、在模块1里，arrange过程：
Sub arrange() Dim ws As Worksheet Dim lasRow As Integer Dim lastCol As Integer Dim arr(), arrRef(), arrRnd(), arrFixed() As String Dim rng As Range Dim fixedDate As String Dim strCheck As String Dim myDate As Date Set ws = ThisWorkbook.Sheets("Sheet1") '生成一个日期，它是星期日。 myDate = Date - Weekday(Date) + 1 '生成一个连接所有星期文本的字符串 For i = 1 To 7 strCheck = strCheck & WeekdayString(myDate + i) & "/" Next strCheck = Left(strCheck, Len(strCheck) - 1) With ws lastRow = .UsedRange.Rows.count lastCol = 4 arr = .Range(.Cells(2, 1), .Cells(lastRow, lastCol)).Value arrRef = .Cells(2, 6).Resize(8, 6).Value For i = 1 To UBound(arrRef) If arrRef(i, 6) = "" Then ReDim Preserve arrRnd(0 To 1, 0 To k) arrRnd(0, k) = arrRef(i, 1) arrRnd(1, k) = arrRef(i, 5) k = k + 1 Else '如果备注不为空，检查星期几的文本是否正确 arrFixed = Split(arrRef(i, 6), "/") For j = LBound(arrFixed) To UBound(arrFixed) If Not InStr(strCheck, arrFixed(j)) > 0 Then MsgBox "星期几文本请按照以下格式填写：" & Chr(10) & strCheck Exit Sub End If Next fixedDate = fixedDate & arrRef(i, 6) & "/" End If Next For i = 1 To UBound(arr) arr(i, 2) = WeekdayString(CDate(arr(i, 1))) If InStr(fixedDate, arr(i, 2)) > 0 Then For j = 1 To UBound(arrRef) If InStr(arrRef(j, 6), arr(i, 2)) Then arr(i, 3) = arrRef(j, 1) arr(i, 4) = arrRef(j, 5) End If Next Else n = m Mod (UBound(arrRnd, 2) + 1) '根据m,生成0-5的数字序列 arr(i, 3) = arrRnd(0, n) arr(i, 4) = arrRnd(1, n) m = m + 1 End If Next End With ws.Range("A2").Resize(UBound(arr), lastCol) = arr Call count '调用统计过程End Sub
代码解析：
（1）Line2~9，定义一些变量，数组、单元格区域、工作表对象，日期、字符串等。
（2）line11~17，生成一个“星期一/.../星期日”的字符串，用于检查“备注”中的星期几字符填写是否正确，防止出错。
（3）line21，把排班明细日期信息读入数组arr，把人员及统计信息读入数组arrRef。
（4）line23~40，循环数组arrRef，如果“备注”为空，就把人员、电话写入数组arrRnd，否则，检查星期几文本，如果不规范则退出过程，反之，把“备注”中的星期几用“/”连接起来，存到fixedDate字符串中。
（5）line41~57，循环数组arr，arrRef，arrRnd，把人员排班写入arr。
（A）line42，根据第一列日期，把第二列写成星期几格式的文本
（B）line43~49，判断arr第二列星期，如果存在于fixedDate中，则把对应的人员写入arr第三列，电话写入第四列。
（C）line51~54，如果“备注”为空，则安排其他人员，顺序安排。通过m累计，通过mod函数生成0-5的数字序列，正好是arrRnd的下标。
（6）line58，把arr数据回写到工作表。
（7）line59，调用count过程，把人员安排与统计区域的值班次数进行更新。
2、在模块1里，count过程：
Sub count() Dim ws As Worksheet Dim lasRow As Integer Dim lastCol As Integer Dim dic As Object, dKey As String Dim arr(), arrRef(), arrRnd() Dim rng As Range Set ws = ThisWorkbook.Sheets("Sheet1") Set dic = CreateObject("Scripting.Dictionary") With ws lastRow = .UsedRange.Rows.count lastCol = 4 arr = .Range(.Cells(2, 1), .Cells(lastRow, lastCol)).Value Set rng = .Cells(2, 6).Resize(8, 6) For i = 1 To UBound(arr) If arr(i, 1) <> "" Then dKey = arr(i, 3) dic(dKey) = dic(dKey) + 1 dKey = arr(i, 3) & Month(arr(i, 1)) dic(dKey) = dic(dKey) + 1 End If Next For i = 1 To 8 rng.Cells(i, 4) = dic(rng.Cells(i, 1).Value) rng.Cells(i, 3) = dic(rng.Cells(i, 1).Value & rng.Cells(i, 2).Value) Next End WithEnd Sub
代码解析：
（1）Line2~7，定义一些变量，数组、单元格区域、工作表对象、字典等。
（2）line13，把排班明细信息读入数组arr。
（3）line14，把人员及统计区域赋值给Range对象rng。
（4）line15~22，循环数组arr，把“姓名”，“姓名+月份”作为关键字装入字典，Item计数。
（5）line23~26，循环1到8，就是rng的8行数据，8个值班人员，把对应人员的值班次数写入工作表。
3、在模块1里，自定义函数WeekDayString
Function WeekdayString(myDate As Date) Dim weekdayNumber As Integer weekdayNumber = Weekday(myDate) '将星期几的数字转为字符串 Select Case weekdayNumber Case 1: WeekdayString = "星期日" Case 2: WeekdayString = "星期一" Case 3: WeekdayString = "星期二" Case 4: WeekdayString = "星期三" Case 5: WeekdayString = "星期四" Case 6: WeekdayString = "星期五" Case 7: WeekdayString = "星期六" Case Else WeekdayString = "" End SelectEnd Function
代码解析：将日期转换成星期几的文本。
4、在工作表中，“排班”、“清除”命令按钮
Private Sub CmdArrange_Click() Call arrangeEnd SubPrivate Sub CmdClear_Click() Range("C2:D" & Me.UsedRange.Rows.count).ClearContents Range("H2:I9").ClearContentsEnd Sub
5、在工作表中，Change事件：
Private Sub Worksheet_Change(ByVal Target As Range) Dim lasRow As Integer Dim lastCol As Integer Dim arr() Dim rng As Range Dim strAddress As String Dim monthTimes As Integer, allTimes As Integer Set rng = Cells(2, 6).Resize(8, 6) For i = 1 To rng.Rows.count strAddress = strAddress & rng.Cells(i, 2).Address & "/" Next If Not InStr(strAddress, Target.Address) > 0 Then Exit Sub End If lastRow = UsedRange.Rows.count lastCol = 4 arr = Range(Cells(2, 1), Cells(lastRow, lastCol)).Value For i = 1 To UBound(arr) If arr(i, 3) = Target.Offset(0, -1).Value Then allTimes = allTimes + 1 If Month(arr(i, 1)) = Target.Value Then monthTimes = monthTimes + 1 End If End If Next Target.Offset(0, 1).Value = monthTimes Target.Offset(0, 2).Value = allTimesEnd Sub
代码解析：
（1）Line2~7，定义一些变量，数组、单元格区域、字符串、整型数值等。
（2）line8，设置rng对象。
（3）line9~11，把月份所在单元格的地址连接成一个字符串strAddress。
（4）line2~14，检查目标单元格的地址是否存在于字符串strAddress中，如果不存在则退出过程。
（4）line17，把排班数据装入arr.
（5）line18~27，循环数组，把目标单元格，就是发生改变的月份所在单元格的值，及其左侧人名在arr中出现的次数进行统计计数，分别得到月份累计值班次数monthTimes以及累计值班次数allTimes，然后写入工作表对应单元格。
总结
1、表格设计应尽量紧凑，尽量避免这一块，那一块的，就好比今天的案例中，“循环值班人员”没有必要单独列出来，我们在数据区域进行标记。
2、原来的需求是有人固定一天值班，比如，星期三，刚开始就按这个模式去写代码的。后来在做“备注”字段中“星期？”的输入规范校验，
突然想到，要是有一个人固定值两天班，应该怎么办呢？
于是，又调整代码。
3、他这个“累计值班次数”，可以理解为所有值班次数的累计，也可以理解为截止当前查询月份累计的值班次数。由于不知道确切的意图，我们按前者来统计，简化处理。
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！