[已解决]统计

cyj153

分类统计.zip (71.8 KB, 下载次数: 19)

2015-12-4 17:30 上传

点击文件名下载附件
谢谢老师！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-12-4 20:35

1. Sub grf()
   
2.    arr = Sheet2.UsedRange
   
3.    ReDim brr(1 To UBound(arr), 1 To 5)
   
4.    Set d = CreateObject("scripting.dictionary")
   
5.    For i = 2 To UBound(arr)
   
6.       x = arr(i, 2) & arr(i, 3) & arr(i, 4)   '年级+项目+赛别为key
   
7.       If Len(x) Then
   
8.         If Not d.exists(x) Then
   
9.            n = n + 1
   
10.            d(x) = n
    
11.            brr(n, 1) = n
    
12.            brr(n, 2) = arr(i, 2)
    
13.            brr(n, 3) = arr(i, 3)
    
14.            brr(n, 4) = arr(i, 4)
    
15.         End If
    
16.         brr(d(x), 5) = brr(d(x), 5) + 1
    
17.       End If
    
18.    Next
    
19.    With Sheet1
    
20.     .[a2:f500].ClearContents
    
21.     .[a2].Resize(n, 5) = brr
    
22.     .[f2].Resize(n, 1).Formula = "=INT((rc[-1]-0.01)/6+1)"
    
23.     .[f2].Resize(n, 1).Value = .[f2].Resize(n, 1).Value
    
24.    End With
    
25. End Sub

复制代码

跳转到最佳答案楼层

爱疯

E列公式得到的结果，符合这个要求吗？“将各项人数写在E列”

sry660

1. Sub 修改grf老师的代码()
   
2.    arr = Sheet2.[a1].CurrentRegion
   
3.    ReDim brr(1 To UBound(arr), 1 To 6)
   
4.    Set d = CreateObject("scripting.dictionary")
   
5.    For i = 2 To UBound(arr)
   
6.       x = arr(i, 2) & arr(i, 3) & arr(i, 4)   '年级+项目+赛别为key
   
7.       If Not d.exists(x) Then
   
8.          n = n + 1
   
9.          d(x) = n
   
10.          brr(n, 1) = n
    
11.          brr(n, 2) = arr(i, 2)
    
12.          brr(n, 3) = arr(i, 3)
    
13.          brr(n, 4) = arr(i, 4)
    
14.          brr(n, 5) = 1
    
15.       Else
    
16.         p = d(x)
    
17.         brr(p, 5) = brr(p, 5) + 1
    
18.     End If
    
19.     For j = 1 To UBound(brr)
    
20.         If brr(j, 5) < 6 Then
    
21.             brr(j, 6) = 1
    
22.         ElseIf brr(j, 5) < 12 Then
    
23.             brr(j, 6) = 2
    
24.         ElseIf brr(j, 5) < 18 Then
    
25.             brr(j, 6) = 3
    
26.         Else
    
27.             brr(j, 6) = 4
    
28.         End If
    
29.     Next
    
30. Next
    
31.    Sheet1.[a2:f500].ClearContents
    
32.    Sheet1.[a2].Resize(n, 6) = brr
    
33. End Sub

复制代码

grf1973

1. Sub grf()
   
2.    arr = Sheet2.UsedRange
   
3.    ReDim brr(1 To UBound(arr), 1 To 5)
   
4.    Set d = CreateObject("scripting.dictionary")
   
5.    For i = 2 To UBound(arr)
   
6.       x = arr(i, 2) & arr(i, 3) & arr(i, 4)   '年级+项目+赛别为key
   
7.       If Len(x) Then
   
8.         If Not d.exists(x) Then
   
9.            n = n + 1
   
10.            d(x) = n
    
11.            brr(n, 1) = n
    
12.            brr(n, 2) = arr(i, 2)
    
13.            brr(n, 3) = arr(i, 3)
    
14.            brr(n, 4) = arr(i, 4)
    
15.         End If
    
16.         brr(d(x), 5) = brr(d(x), 5) + 1
    
17.       End If
    
18.    Next
    
19.    With Sheet1
    
20.     .[a2:f500].ClearContents
    
21.     .[a2].Resize(n, 5) = brr
    
22.     .[f2].Resize(n, 1).Formula = "=INT((rc[-1]-0.01)/6+1)"
    
23.     .[f2].Resize(n, 1).Value = .[f2].Resize(n, 1).Value
    
24.    End With
    
25. End Sub

复制代码