排名问题如何按校、年级、班级排名

xw3141

排名问题如何分校、分年级、分班级排名

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d(0 To 2) As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   For k = 0 To 2
   
8.     Set d(k) = CreateObject("scripting.dictionary")
   
9.   Next
   
10.   vs = Array(Array(1, 3, 4), Array(1, 3), Array(3))
    
11.   With Worksheets("sheet1")
    
12.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
13.     .Range("l2:n" & r).ClearContents
    
14.     arr = .Range("a2:n" & r)
    
15.     For i = 1 To UBound(arr)
    
16.       For k = 0 To UBound(vs)
    
17.         xm = Empty
    
18.         For q = 0 To UBound(vs(k))
    
19.           xm = xm & arr(i, vs(k)(q))
    
20.         Next
    
21.         If Not d(k).exists(xm) Then
    
22.           Set d(k)(xm) = CreateObject("scripting.dictionary")
    
23.         End If
    
24.         d(k)(xm)(arr(i, 11)) = d(k)(xm)(arr(i, 11)) + 1
    
25.       Next
    
26.     Next
    
27.     For k = 0 To UBound(d)
    
28.       For Each aa In d(k).keys
    
29.         kk = d(k)(aa).keys
    
30.         nn = 1
    
31.         For q = 0 To UBound(kk)
    
32.           mm = Application.Large(kk, q + 1)
    
33.           ss = d(k)(aa)(mm)
    
34.           d(k)(aa)(mm) = nn
    
35.           nn = nn + ss
    
36.         Next
    
37.       Next
    
38.     Next
    
39.     For i = 1 To UBound(arr)
    
40.       For k = 0 To UBound(vs)
    
41.         xm = Empty
    
42.         For q = 0 To UBound(vs(k))
    
43.           xm = xm & arr(i, vs(k)(q))
    
44.         Next
    
45.         arr(i, k + 12) = d(k)(xm)(arr(i, 11))
    
46.       Next
    
47.     Next
    
48.     .Range("a2:n" & r) = arr
    
49.   End With
    
50. End Sub
    

复制代码

chxw68

详见附件。

hcm19522

F2=COUNTIFS(A:A,A2,C:C,C2,D:D,D2,E:E,">"&E2)+1

G2=COUNTIFS(A:A,A2,C:C,C2,E:E,">"&E2)+1

H2=COUNTIFS(A:A,A2,E:E,">"&E2)+1

I2=COUNTIF(E:E,">"&E2)+1

cai2532

这个排名函数真实用。