[已解决]统计

cyj153

数据统计3.zip (20.26 KB, 下载次数: 15)

2017-7-27 22:29 上传

点击文件名下载附件
增加条件后，如何统计？谢谢老师！

最佳答案

月排行榜 / 总排行榜

grf1973

2017-7-28 15:30

1. Sub grf()
   
2.     arr = Sheet1.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         qsl = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4)   '前4列条件
   
6.         x = qsl & arr(i, 5) & arr(i, 6) & arr(i, 7)   '号码+姓名+节次
   
7.         y = qsl & arr(i, 5) & arr(i, 6) & "合计"      '号码+姓名+合计
   
8.         If Len(arr(i, 9)) Then       '统计  号码+姓名+节次 的暂停次数，并合计
   
9.             d(x & "暂停") = d(x & "暂停") + 1
   
10.             d(y & "暂停") = d(y & "暂停") + 1
    
11.         End If
    
12.         If Len(arr(i, 10)) Then       '统计  号码+姓名+节次 的犯规次数，并合计
    
13.             d(x & "犯规") = d(x & "犯规") + 1
    
14.             d(y & "犯规") = d(y & "犯规") + 1
    
15.         End If
    
16.         If Len(arr(i, 11)) Then      '统计  号码+姓名+节次 的分值，并合计
    
17.             d(x & "分值") = d(x & "分值") + arr(i, 11)
    
18.             d(y & "分值") = d(y & "分值") + arr(i, 11)
    
19.         End If
    
20.         If Len(arr(i, 12)) Then        '统计  号码+姓名 的说明，成字符串
    
21.             x = qsl & arr(i, 5) & arr(i, 6) & "说明"
    
22.             d(x) = d(x) & "," & arr(i, 12)
    
23.         End If
    
24.     Next
    
25.    
    
26.     For k = 3 To 23 Step 20     '上下两个表
    
27.         arr = Cells(k, 1).Resize(13, 23)      '上下两个表的区间
    
28.         kk = k - 1
    
29.         qsl = Cells(kk, "D") & Cells(kk, "A") & Cells(kk, "E") & IIf(kk = 2, Cells(kk, "G"), Cells(kk, "K"))   '对应前4列的条件
    
30.         For j = 5 To 23
    
31.             If arr(1, j) = "" Then arr(1, j) = arr(1, j - 1)    '第一行为节次
    
32.             For i = 3 To UBound(arr)
    
33.                 If arr(i, 2) <> "" Then      '除最后一列外，key=号码+姓名+（节次/合计）+（暂停/犯规/分值），最后一列key=号码+姓名+说明
    
34.                     x = IIf(j < 23, arr(i, 2) & arr(i, 3) & arr(1, j) & arr(2, j), arr(i, 2) & arr(i, 3) & arr(1, j))
    
35.                     x = qsl & x
    
36.                     arr(i, j) = IIf(j < 23, d(x), Mid(d(x), 2))
    
37.                 End If
    
38.             Next
    
39.         Next
    
40.         Cells(k, 1).Resize(13, 23) = arr    '显示结果
    
41.     Next
    
42. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub grf()
   
2.     arr = Sheet1.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         qsl = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4)   '前4列条件
   
6.         x = qsl & arr(i, 5) & arr(i, 6) & arr(i, 7)   '号码+姓名+节次
   
7.         y = qsl & arr(i, 5) & arr(i, 6) & "合计"      '号码+姓名+合计
   
8.         If Len(arr(i, 9)) Then       '统计  号码+姓名+节次 的暂停次数，并合计
   
9.             d(x & "暂停") = d(x & "暂停") + 1
   
10.             d(y & "暂停") = d(y & "暂停") + 1
    
11.         End If
    
12.         If Len(arr(i, 10)) Then       '统计  号码+姓名+节次 的犯规次数，并合计
    
13.             d(x & "犯规") = d(x & "犯规") + 1
    
14.             d(y & "犯规") = d(y & "犯规") + 1
    
15.         End If
    
16.         If Len(arr(i, 11)) Then      '统计  号码+姓名+节次 的分值，并合计
    
17.             d(x & "分值") = d(x & "分值") + arr(i, 11)
    
18.             d(y & "分值") = d(y & "分值") + arr(i, 11)
    
19.         End If
    
20.         If Len(arr(i, 12)) Then        '统计  号码+姓名 的说明，成字符串
    
21.             x = qsl & arr(i, 5) & arr(i, 6) & "说明"
    
22.             d(x) = d(x) & "," & arr(i, 12)
    
23.         End If
    
24.     Next
    
25.    
    
26.     For k = 3 To 23 Step 20     '上下两个表
    
27.         arr = Cells(k, 1).Resize(13, 23)      '上下两个表的区间
    
28.         kk = k - 1
    
29.         qsl = Cells(kk, "D") & Cells(kk, "A") & Cells(kk, "E") & IIf(kk = 2, Cells(kk, "G"), Cells(kk, "K"))   '对应前4列的条件
    
30.         For j = 5 To 23
    
31.             If arr(1, j) = "" Then arr(1, j) = arr(1, j - 1)    '第一行为节次
    
32.             For i = 3 To UBound(arr)
    
33.                 If arr(i, 2) <> "" Then      '除最后一列外，key=号码+姓名+（节次/合计）+（暂停/犯规/分值），最后一列key=号码+姓名+说明
    
34.                     x = IIf(j < 23, arr(i, 2) & arr(i, 3) & arr(1, j) & arr(2, j), arr(i, 2) & arr(i, 3) & arr(1, j))
    
35.                     x = qsl & x
    
36.                     arr(i, j) = IIf(j < 23, d(x), Mid(d(x), 2))
    
37.                 End If
    
38.             Next
    
39.         Next
    
40.         Cells(k, 1).Resize(13, 23) = arr    '显示结果
    
41.     Next
    
42. End Sub

复制代码

cyj153

grf1973 发表于 2017-7-28 15:30

谢谢老师！