Excel VBA 案例详解 排班表 值班统计表

本文于2023年10月1日首发于本人同名***更多文章案例请搜索关注！

排班表。值班统计表。

大家好，我是冷水泡茶，今天在excelhome论坛上看到一个求助贴，

[求助] 这个值班表做起来有难度。

我们再看看他的数据表：

经过仔细分析，觉得他的这个表的设计可以调整一下，在右上人员及统计区域，我们增加一栏“备注”，填写固定值班人员的星期信息，这样写**要容易一点，同时，今后有什么调整，也很方便。右下循环值班人员就不要了，我们可以在**中生成。

另外，他这个月份是一个下拉列表，1-12月，我想他的用意是选择月份，对应统计该人员的当月值班次数据及累计值班次数。

花了点时候做了一下，分享给大家：

1、把左边的排班明细信息装入数组arr，把右边的人员及统计信息装入数组arrref。

2、循环arrref，把非固定星期几值班的人员写入数组arrrnd。

3、循环两个数组，如果碰到固定日期，则把对应的人员填入arr，否则就顺序填入非固定人员。

3、把arr数据回写到工作表。

4、统计月度、累计值班次数。

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) 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

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~~~

喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！

Excel VBA 案例更新 工作表权限控制 工作表命令按钮权限控制

本文于年月日首发于本人同名其他平台，更多文章案例请搜索关注！用户窗体控件 多页。工作表命令按钮权限控制。大家好，我是冷水泡茶，前几天我们分享了一个案例 工作表权限控制 后来应粉丝朋友的需求增加了工作表保护 密码修改功能 excel vba 案例更新 工作表权限控制 保护工作表 工作表禁止添加删除改名...

链动2 1详细案例解析

在这个独特的舞台上，每个人都有可能成为那颗闪耀的明星，只要他们具备坚定的信念和毅力。这个舞台就像一个强大的弹簧，可以帮助人们跳过生活中的各种障碍，让他们无所畏惧地向前。它的运作方式独特而富有创意，通过推荐两个人加入这个舞台并帮助他们获得成功，人们就可以晋升到更高的级别。这个级别会为人们带来更多的机会...

赌球案将牵涉到国米？详解处罚条例 蓝黑军已经是输家

意大利的赌球案成为当前的热点话题，对于国际米兰球队而言，这可能成为一场灾难。这篇文章将详细解析处罚条例，以及赌球案对于国际米兰和整个意甲的影响。最近几年，赌球案在意大利成为了频繁发生的事件，这不仅让足球界蒙上了阴影，也对球队的形象和信任度产生了严重的影响。尽管目前还没有确凿的证据证明国际米兰球员涉案...