麻辣家族討論版版 - Powered by Discuz! Board

Sub MySumIF()
ar = Array("學生", "嘉獎", "小功", "大功", "小計")
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With Sheet4
For i = 1 To 3
mysum = 0
For Each a In .Range(.[B2], .[B65536].End(xlUp))
d(a & ar(i)) = d(a & ar(i)) + a.Offset(, i)
If IsNumeric(a.Offset(, i)) Then _
mysum = mysum + a.Offset(, i): _
d1(a & "") = d1(a & "") + a.Offset(, i): _
d2(a & "") = d2(a & "") + a.Offset(, i)
Next
d("小計" & ar(i)) = mysum
d1("小計") = ""
d2("小計") = d2("小計") + mysum
Next
End With
With Sheet3
.[B5:F65536] = ""
.[B5].Resize(, 5) = ar
.[B6].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
For Each a In .Range(.[B6], .[B65536].End(xlUp))
For i = 1 To 4
a.Offset(, i) = IIf(i = 4, d2(a & ""), d(a & ar(i)))
Next
Next
End With
End Sub
Sub MyCountIF()
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With Sheet2
For Each a In .Range(.[A2], .[A65536].End(xlUp))
d(a & a.Offset(, 1)) = d(a & a.Offset(, 1)) + 1
d1(a & "") = "": If a.Offset(, 1) <> "成績" Then d2(a.Offset(, 1).Value) = ""
Next
End With
With Sheet1
.[B6:M65536] = ""
.[B5].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
.[C5].Resize(, d2.Count) = d2.keys
ar = d2.keys
For Each a In .Range(.[B6], .[B65536].End(xlUp))
For i = 0 To UBound(ar)
a.Offset(, i + 1) = d(a & ar(i)): cnt = cnt + d(a & ar(i))
Next
a.Offset(, UBound(ar) + 2) = cnt: cnt = 0
Next
Set a = .[B65536].End(xlUp).Offset(1, 0)
For i = 0 To UBound(ar)
a.Offset(, i + 1) = Application.Sum(.Range(.[B5].Offset(, i + 1), a.Offset(-1, i + 1)))
Next
End With
End Sub

複製代碼