­ã´£³¡ªL

Sub update()
Dim Arr, xD, T$, i&, U&, S, N&
[sheet1!A:B].ClearContents
Arr = Range([data!B1], [data!A65536].End(xlUp))
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
    T = Arr(i, 1):  If T = "" Then GoTo 101
    U = xD(T): S = Val(Arr(i, 2))
    If U = 0 Then
       N = N + 1:   U = N:   xD(T) = N
       Arr(U + 1, 1) = T:    Arr(U + 1, 2) = 0
    End If
    Arr(U + 1, 2) = Arr(U + 1, 2) + S
101: Next
If N = 0 Then Exit Sub
With [sheet1!A1:B1].Resize(N + 1)
     .Columns(1).NumberFormatLocal = "@"
     .Value = Arr
End With
End Sub

================================