1.  汇总（字典，数组） 

Sub kf2()
Dim d As Object, a, b, j%, w!
Dim ss As String, n As Integer, x
Me.UsedRange.Offset(3, 0) = ""           ‘这句用法没见过
a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp))
Set d = CreateObject("scripting.dictionary")
ReDim b(1 To UBound(a), 1 To 8)
For i = 1 To UBound(a)
ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8)
If Not d.Exists(ss) Then
n = n + 1
d.Add ss, n
b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4)
b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9)
Else
b(d(ss), 7) = b(d(ss), 7) & "+" & a(i, 9)
End If
Next
For i = 1 To d.Count      ‘本来用evaluate方法的，但是受限于其参数需<256个字符
x = Split(b(i, 7), "+")     ‘改用此法，甚妙！
For j = 0 To UBound(x)
w = w + x(j)
Next j
b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0
Next
[b4].Resize(n, 8) = b
End Sub