|
年级排名代码
- Sub test4(ByVal cs As Variant)
- Dim r%, i%
- Dim arr, brr, zrr()
- Dim d(1 To 2) As Object
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- For i = 1 To 2
- Set d(i) = CreateObject("scripting.dictionary")
- Next
- With Worksheets("录入成绩")
- r = .Cells(.Rows.Count, 4).End(xlUp).Row
- arr = .Range("a3:p" & r)
- End With
- ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + 4)
- For i = 1 To UBound(arr)
- For j = 5 To 16
- If j <= 7 Then
- arr(i, 17) = arr(i, 17) + arr(i, j)
- End If
- arr(i, 19) = arr(i, 19) + arr(i, j)
- Next
- d(1)(arr(i, 17)) = d(1)(arr(i, 17)) + 1
- d(2)(arr(i, 19)) = d(2)(arr(i, 19)) + 1
- Next
- For i = 1 To 2
- nn = 1
- kk = d(i).keys
- For k = 0 To UBound(kk)
- mm = Application.Large(kk, k + 1)
- ss = d(i)(mm)
- d(i)(mm) = nn
- nn = nn + ss
- Next
- Next
- For i = 1 To UBound(arr)
- arr(i, 18) = d(1)(arr(i, 17))
- arr(i, 20) = d(2)(arr(i, 19))
- Next
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
- m = 0
- For i = 1 To UBound(arr)
- If arr(i, cs(3)) >= cs(1) And arr(i, cs(3)) <= cs(2) Then
- m = m + 1
- For j = 1 To UBound(arr, 2)
- brr(m, j) = arr(i, j)
- Next
- End If
- Next
- With Worksheets("年级排名")
- .UsedRange.Offset(3, 0).Clear
- With .Range("a1")
- .Value = Split(Worksheets("录入成绩").Range("a1").Value, "成绩")(0) & vbLf & "年段第" & cs(1) & "-" & cs(2) & "名成绩排名表"
- With .Font
- .Size = 18
- .Bold = True
- End With
- End With
- .Rows(1).RowHeight = 50
- .Range("a4").Resize(m, UBound(brr, 2)) = brr
- .Range("a4:t" & m + 3).Sort key1:=.Cells(4, cs(3)), order1:=xlAscending, Header:=xlNo
- .Range("a2:t" & m + 3).Borders.LineStyle = xlContinuous
- End With
- End Sub
复制代码 |
|