samwang

¦^´_ 1# aer

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, T$, T1, n&, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = [A1].CurrentRegion
For i = 2 To UBound(Arr)
    If Arr(i, 2) = "" Then GoTo 99
    T = Left(Arr(i, 1), 15)
    If xD.Exists(T) Then
        Arr(xD(T), 2) = Arr(xD(T), 2) + Arr(i, 2)
    Else
        n = n + 1: xD(T) = n
        Arr(n, 1) = T: Arr(n, 2) = Arr(i, 2)
    End If
    T1 = T1 + Arr(i, 2)
99: Next
[e1].CurrentRegion.Offset(1) = ""
[e2].Resize(n, 2) = Arr
Range("e" & n + 2) = "¦X­p"
Range("f" & n + 2) = T1
End Sub