|
换个使用工作表函数的思路,供参考。- Sub grf1()
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- Set sh = Worksheets("成绩")
- km = "语文" '科目
- arr = Sheets("教师").[a1].CurrentRegion
- ReDim brr(1 To UBound(arr), 1 To 6)
- For i = 2 To UBound(arr)
- xm = arr(i, 4) '姓名
- x = arr(i, 1) & arr(i, 2) '学校+班级
- If Not d.exists(xm) Then
- n = n + 1
- d(xm) = n
- brr(n, 1) = arr(i, 1)
- brr(n, 2) = xm
- brr(n, 4) = km
- End If
- p = d(xm)
- brr(p, 3) = brr(p, 3) & "," & arr(i, 2)
- brr(p, 5) = brr(p, 5) + Application.WorksheetFunction.CountIfs(sh.[a:a], arr(i, 1), sh.[d:d], arr(i, 2), sh.[e:e], ">0")
- brr(p, 6) = brr(p, 6) + Application.WorksheetFunction.SumIfs(sh.[e:e], sh.[a:a], arr(i, 1), sh.[d:d], arr(i, 2))
- Next
- For p = 1 To n
- brr(p, 3) = Mid(brr(p, 3), 2)
- rs = rs + brr(p, 5) '人数
- zf = zf + brr(p, 6) '总分
- brr(p, 6) = brr(p, 6) / brr(p, 5) '平均分
- Next
-
- With Sheets("结果")
- .[a5].Resize(n, 6) = brr
- .[a4] = "合 计"
- .[d4] = km
- .[e4] = rs
- .[f4] = zf / rs
- .[g5].Resize(n).Formula = "=rank(rc[-1],r5c[-1]:r" & 4 + n & "c[-1])" '名次
- End With
- End Sub
复制代码 |
|