una macro es buena solución...
Option Explicit
'//By JuanC - Dic. 2008
Private Declare Function apiGetProcessHeap Lib "kernel32" Alias "GetProcessHeap" () As Long
Private Declare Function apiHeapAlloc Lib "kernel32" Alias "HeapAlloc" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function apiHeapFree Lib "kernel32" Alias "HeapFree" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Sub apiCopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub apiMemorySet Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, Source As Any, ByVal Length As Long)
Private Declare Sub apiMemoryGet Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Const HEAP_ZERO_MEMORY = &H8
Public Type MyStruct
value As String * 255
address As String * 255
End Type
Sub test()
Dim i&, x As Variant, j&, s$
Dim rng As Range, ptr&, hHeap&
Dim w As MyStruct
Dim col As New Collection
On Error Resume Next
[A1].Select
hHeap = apiGetProcessHeap()
With Selection
x = .Offset(i).value
Do While Trim(x) <> ""
w.value = .Offset(i, 1).value
w.address = .Offset(i, 1).address(0, 0)
ptr = apiHeapAlloc(hHeap, HEAP_ZERO_MEMORY, Len(w))
Call apiMemorySet(ptr, w, Len(w))
Err.Clear
col.Add ptr, CStr(x)
If Err.Number = 457 Then
ptr = CLng(col.Item(CStr(x)))
Call apiMemoryGet(w, ptr, Len(w))
Range(RTrim(CStr(w.address))).value = Range(RTrim(CStr(w.address))).value + Val(RTrim(CStr(w.value)))
If rng Is Nothing Then
Set rng = .Offset(i)
Else
Set rng = Union(rng, .Offset(i))
End If
End If
i = i + 1
x = .Offset(i).value
Loop
End With
If Not rng Is Nothing Then rng.EntireRow.Delete
hHeap = apiGetProcessHeap()
For i = 1 To col.Count
ptr = CLng(col.Item(i))
Call apiHeapFree(hHeap, 0, ptr)
Next
Set rng = Nothing
Set col = Nothing
End Sub
Saludos desde Baires, JuanC