vba按字典多条件统计分组班级平均分

zax010

>>>>>>>>>>>>>>>>>>>>>>

班级平均分统计（按组别）.rar (41.38 KB, 下载次数: 119)

2015-7-2 08:59 上传

点击文件名下载附件

hank2611

真的很     快捷

chxw68

厉害！去年的贴子都能翻出来。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   Set d1 = CreateObject("scripting.dictionary")
   
7.   With Worksheets("sheet1")
   
8.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.     arr = .Range("c3:e" & r)
   
10.     For i = 1 To UBound(arr)
    
11.       If Not d.exists(arr(i, 1)) Then
    
12.         Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
    
13.       End If
    
14.       If Not d(arr(i, 1)).exists(arr(i, 2)) Then
    
15.         ReDim brr(1 To 4)
    
16.         brr(1) = arr(i, 1)
    
17.         brr(2) = arr(i, 2)
    
18.       Else
    
19.         brr = d(arr(i, 1))(arr(i, 2))
    
20.       End If
    
21.       brr(3) = brr(3) + arr(i, 3)
    
22.       brr(4) = brr(4) + 1
    
23.       d(arr(i, 1))(arr(i, 2)) = brr
    
24.     Next
    
25.     n = 7
    
26.     For Each aa In d.keys
    
27.       arr = Application.Transpose(Application.Transpose(d(aa).items))
    
28.       d1.RemoveAll
    
29.       For i = 1 To UBound(arr)
    
30.         If arr(i, 4) <> 0 Then
    
31.           arr(i, 3) = Round(arr(i, 3) / arr(i, 4), 2)
    
32.           d1(arr(i, 3)) = d1(arr(i, 3)) + 1
    
33.         End If
    
34.       Next
    
35.       nn = 1
    
36.       kk = d1.keys
    
37.       For k = 0 To UBound(kk)
    
38.         mm = Application.Large(kk, k + 1)
    
39.         ss = d1(mm)
    
40.         d1(mm) = nn
    
41.         nn = nn + ss
    
42.       Next
    
43.       For i = 1 To UBound(arr)
    
44.         arr(i, 4) = d1(arr(i, 3))
    
45.       Next
    
46.       .Cells(4, n).Resize(UBound(arr), UBound(arr, 2)) = arr
    
47.       r = .Cells(.Rows.Count, n).End(xlUp).Row
    
48.       .Range(.Cells(2, n), .Cells(r, n + 3)).Borders.LineStyle = xlContinuous
    
49.       n = n + 5
    
50.     Next
    
51.   End With
    
52. End Sub
    

复制代码

chxw68

呵呵，闲来没事练练手。

txh0011

记号，学习一下

10307951261

留名收藏，也许以后有用

chxw68

10307951261 发表于 2022-4-21 14:41
留名收藏，也许以后有用

收藏一般用[收藏]功能，这样跟贴的话会把老贴子顶上来。

lcmphy

15楼功能很强大！组别增加了，也可以统计出来。
一次联考，有多个组别，有多个科目，类似的，应该可以一次性把每个组每个科目的参考人数、平均分、排名统计出来。原始数据如下附件sheet1工作表，效果如附件统计工作表。
根据前面帖子，属于求助帖子，但是感觉内容与本帖大同小异，故补充到本帖后面求助。

lcmphy

chxw68 发表于 2016-11-25 22:21
呵呵，闲来没事练练手。

字典功能太强大了，但是模仿不了，19楼的附件与这个类似，EH侠圣能百忙中帮助一下么？先谢谢了