|
发表于 2015-12-31 16:06
|
显示全部楼层
本楼为最佳答案
- Sub Macro1()
- Dim arr, brr, d, d2, i&, j%
- Set d = CreateObject("scripting.dictionary") '学校
- Set d2 = CreateObject("scripting.dictionary") '学校+学科
- arr = Sheet3.Range("a2").CurrentRegion
- w = Array("语文", "数学", "英语", "物理", "化学", "生物", "总分")
- For i = 2 To UBound(arr)
- d(arr(i, 5)) = d(arr(i, 5)) + 1
- For j = 8 To 15
- zf = arr(i, 5) & "," & arr(1, j)
- d2(zf) = d2(zf) + arr(i, j)
- Next
- Next
- ReDim brr(1 To d.Count, 1 To 16)
- a = d.keys: b = d.items
- For i = 0 To d.Count - 1
- brr(i + 1, 1) = a(i)
- brr(i + 1, 2) = b(i)
- For j = 0 To UBound(w)
- zf = a(i) & "," & w(j)
- brr(i + 1, (j + 1) * 2 + 1) = Application.Round(d2(zf) / b(i), 2)
- Next
- Next
- Sheet2.Range("a15").Resize(UBound(brr), UBound(brr, 2)) = brr
- End Sub
复制代码 |
|