VBA汇总每日作业工时

杨大敏

每天都需要统计大家反馈的作业工时，给工作带来非常低的效率，希望有会的老师帮忙解答一下，非常感谢。



功能要求：
1.从数据源工作表里获得每个人每日的工作时间。
2.计算每个人的工作时间汇总到“汇总表”里，对应的日期存放在单元格里；

要求说明：
1.数据源每日工作内容都有填写每个作业多少分钟时间，将每个人的每日作业时间合并起来累加存放到“汇总”表格里面就可以了。

2.这里有个例子，假如1日，只有李云涛作业时间为480分钟，既汇总表里B9等于480，比如高凌烽数据源45分钟+40分钟+45分钟，既汇总表里C3等于130。大家都是以分钟作为统计。

3.数据源日期是1日-31日，对应汇总表也是1日到31日。


做好的老师帮忙上传附件哈。

ykcbf1100

这里的难点在时间的处理上，用正则会方便一点。

附件供参考。。。

shiruiqiang

你数据有点不规范，导致正则表达式取时间 ，会有点小问题（如3号有个100，没分钟）。
字典+正则i时间

杨大敏

shiruiqiang 发表于 2024-1-28 22:33
你数据有点不规范，导致正则表达式取时间 ，会有点小问题（如3号有个100，没分钟）。
字典+正则i时间

非常谢谢你发现漏洞，数据源没有分钟只有数值的就忽略过去，就如你说的数据源D2有个100没有分钟就忽略过去不累加，只累加带有分钟数据的。

数据源这边同事编写时会录入遗漏了，错误的就不累加。

dragonthree

1. Sub kj()
   
2. Dim regEX
   
3. Set regEX = CreateObject("VBSCRIPT.REGEXP")
   
4. arr = Sheet1.Range("b2:af19")
   
5. regEX.Global = True '设置查找返回全部匹配
   
6. regEX.IgnoreCase = False '设置查找不区分大小写
   
7. regEX.Pattern = "(\d+)(分钟)"
   
8. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
9. For i = 1 To UBound(arr)
   
10.     For j = 1 To UBound(arr, 2)
    
11.        x = regEX.Execute(arr(i, j)).Count
    
12.        For m = 0 To x - 1
    
13.             brr(i, j) = brr(i, j) + Val(regEX.Execute(arr(i, j))(m).submatches(0))
    
14.        Next
    
15.     Next
    
16. Next
    
17. Sheet2.Range("b3:af20") = brr
    
18. End Sub
    
19. 
    

复制代码

shiruiqiang

随手练个吧

shiruiqiang

目前只能“汇总表”人员名字不动，否则排名看不出来。
建议把人员分组好，排名啥的可以一起完成

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.29
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set reg = CreateObject("VBScript.Regexp")
   
6.     With Sheets("数据源")
   
7.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
8.         arr = .Range("a1:af" & r)
   
9.     End With
   
10.     With reg
    
11.         .Global = True
    
12.         .Pattern = "(\d+)分钟"
    
13.         For i = 2 To UBound(arr)
    
14.             For j = 2 To UBound(arr, 2)
    
15.                 If arr(i, j) <> Empty Then
    
16.                     st = arr(i, j)
    
17.                     Sum = 0
    
18.                     Set mh = .Execute(st)
    
19.                     For Each k In mh
    
20.                         Sum = Sum + Val(k.Value)
    
21.                     Next
    
22.                     s = arr(i, 1) & "|" & arr(1, j)
    
23.                     d(s) = Sum
    
24.                 End If
    
25.             Next
    
26.         Next
    
27.     End With
    
28.     With Sheets("汇总")
    
29.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
30.         arr = .Range("a1:af" & r)
    
31.         For i = 3 To UBound(arr)
    
32.             For j = 2 To UBound(arr, 2)
    
33.                 s = arr(i, 1) & "|" & arr(2, j)
    
34.                 If d.Exists(s) Then
    
35.                     arr(i, j) = d(s)
    
36.                 End If
    
37.             Next
    
38.         Next
    
39.         .Range("a1:af" & r) = arr
    
40.     End With
    
41.     Set d = Nothing
    
42.     Application.ScreenUpdating = True
    
43.     MsgBox "OK！"
    
44. End Sub
    

复制代码

凡尘158

源数据里面每个日期下面用两列，一个写工作内容，一个写工作的时间，
每个人每一项工作用一行记录，当天有多个工作内容，就用多行记录
这样会不会更好一点？

杨大敏

ykcbf1100 发表于 2024-1-29 07:49
这里的难点在时间的处理上，用正则会方便一点。

附件供参考。。。

老师每次都能看懂我所表达的功能要求，非常感谢，这个解决了我的问题，我先把一个月的数据源录入进去看看有没有错误。

目前来看1-7日数据源汇总正确，非常感谢，2朵鲜花补上。