Option Explicit
Sub test()
Dim d As Object, ar, i&, j&, k&, s$
Set d = CreateObject("Scripting.Dictionary")
ar = [a1].CurrentRegion.Resize(, 8)
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
k = 1
For j = 1 To UBound(ar, 2)
br(k, j) = ar(1, j)
Next
For i = 2 To UBound(ar)
s = ar(i, 1)
d(s) = d(s) + ar(i, 2)
If LCase(ar(i, UBound(ar, 2))) = "main" Then
k = k + 1
br(k, 1) = s
For j = 3 To UBound(ar, 2)
br(k, j) = ar(i, j)
Next
End If
Next
For i = 2 To k
br(i, 2) = d(br(i, 1))
Next
[a14].Resize(k, UBound(br, 2)) = br
Set d = Nothing
End Sub |