用vba代码统计总数

grf1973

修正了一下。可以在空白表上直接生成姓名和违规类型。
3楼代码由于源数据问题，“说闲话”统计不准（共24个，有8个统计到“次说闲话”中去了）。

1. Sub 统计()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set dlx = CreateObject("scripting.dictionary")   '对于违规类型字典
   
4.     kk = 3
   
5.     Dim ar(1 To 10000, 1 To 50)
   
6.     With CreateObject("vbscript.regexp")
   
7.         .Global = True
   
8.         .Pattern = "([\u4e00-\u9fa5]+)(\d+)"   '找到 “迟到1”这种内容
   
9.         For Each sh In Sheets
   
10.             If InStr(sh.Name, "月") > 0 Then
    
11.                 br = sh.[a1].CurrentRegion
    
12.                 For i = 2 To UBound(br)
    
13.                     x = Trim(br(i, 2))
    
14.                     If x <> "" Then
    
15.                         If Not d.exists(x) Then
    
16.                             k = k + 1
    
17.                             d(x) = k
    
18.                             For j = 1 To 3: ar(k, j) = br(i, j): Next j
    
19.                         End If
    
20.                         p = d(x)
    
21.                         For j = 4 To UBound(br, 2)
    
22.                             s = Trim(br(i, j))
    
23.                             s = Replace(s, "次", "次/")  '源数据里有误，用代码修正一下，不然会出现“次说闲话”的违规类型。
    
24.                             If .test(s) <> "" Then
    
25.                                 For Each m In .Execute(s)
    
26.                                     lx = m.submatches(0)   '违规类型
    
27.                                     cs = Val(m.submatches(1))   '违规次数
    
28.                                     If Not dlx.exists(lx) Then kk = kk + 1: dlx(lx) = kk
    
29.                                     c = dlx(lx)
    
30.                                     ar(p, c) = ar(p, c) + cs
    
31.         Next m: End If: Next j: End If: Next i: End If: Next sh
    
32.     End With
    
33.         
    
34.     With Sheets("统计")
    
35.         .Cells.ClearContents
    
36.         .[a1].Resize(1, 3) = Array("姓名", "编号", "性别")
    
37.         .[d1].Resize(1, dlx.Count) = dlx.keys
    
38.         .[a2].Resize(k, dlx.Count + 3) = ar
    
39.     End With
    
40.     MsgBox "ok!"
    
41. End Sub

复制代码

adud

半百 发表于 2023-7-7 11:36
请测试

谢谢啊，我一会儿看看怎么样。

沈默00

厉害，过来学习下

chxw68

参与一下。

adud

grf1973 发表于 2023-7-7 11:20
小改了一下3楼的代码，用正则查找违规类型和次数。

这跟上面的功能一样，代码简洁多了。但我看起来更难看懂了，超过了我的理解水平。，但还是非常感谢啊。

adud

grf1973 发表于 2023-7-7 11:43
修正了一下。可以在空白表上直接生成姓名和违规类型。
3楼代码由于源数据问题，“说闲话”统计不准（共24 ...

那个地方确实是我输入有误，这都发现了啊，真是太负责任了。谢谢帮忙

adud

chxw68 发表于 2023-7-7 15:23
参与一下。

要是能保留统计那个表中的数据不清零（在原数据的基础上累加），因为有历史数据（也可以有后续熟路），不单单这三个月，是不是更复杂了？

chxw68

adud 发表于 2023-7-7 17:19
要是能保留统计那个表中的数据不清零（在原数据的基础上累加），因为有历史数据（也可以有后续熟路），不 ...

你这样设计，点一次加一次，数据就乱套了。

adud

我的本意就是统计学生对于某个知识点在一年测试中出现错误的次数，用来反映学生知识点的掌握情况。每次考试出错的地方都要累计起来，为以后教学考试命题提供参考。上面的模拟数据最后应该是加一次后就要自动删除的。你应该明白我的意思了吧？

chxw68

修改好了。