|
- Sub tt()
- brr = Sheets("输入表").[a1].CurrentRegion
- ReDim arr(1 To UBound(brr), 1 To 32)
- For i = 3 To UBound(brr)
- For j = 1 To 4 '导入前4列数据
- arr(i - 2, j) = brr(i, j)
- Next
- For j = 5 To UBound(brr, 2) '导入各科成绩
- arr(i - 2, (j - 5) * 3 + 5) = Val(brr(i, j))
- arr(i - 2, 32) = arr(i - 2, 32) + Val(brr(i, j))
- Next
- Next
- Range("a4").Resize(UBound(arr), UBound(arr, 2)) = arr
-
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1:ai" & [c65536].End(3).Row): r = UBound(arr)
- For j = 5 To 32 Step 3 'j对应成绩列
- Set xrng = Cells(4, j).Resize(r - 3, 1) 'j列(用于计算年级排名)
- If Application.WorksheetFunction.Sum(xrng) > 0 Then 'j列非空
- For i = 4 To UBound(arr)
- bj = arr(i, 3): fs = Val(arr(i, j)) '班级,分数
- arr(i, j + 2) = Application.WorksheetFunction.Rank(fs, xrng) '年级排名
- If Not d.exists(bj) Then Set d(bj) = Cells(i, j) Else Set d(bj) = Union(d(bj), Cells(i, j)) '把相同班级单元格存入字典,用于计算班级排名
- Next
- For i = 4 To UBound(arr)
- bj = arr(i, 3): fs = arr(i, j)
- arr(i, j + 1) = Application.WorksheetFunction.Rank(fs, d(bj)) '班级排名
- If j = 32 Then arr(i, j + 3) = arr(i, j + 1) - arr(i, j + 2) '最后一列“进步”(按原公式)
- Next
- d.RemoveAll
- End If
- Next
- Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
- End Sub
复制代码 |
|