不用字典//排序法//上下比對//
<直貼代碼>....就是要經过"大審婆"...從廣州審到杭州...
EH逼得大家去用圖片或只上傳附件~~
Sub TEST_A2()
Dim Arr, Brr, T$, T1$, T2$, TT$, i&, j%, N&
With Range([c2], [a65536].End(3))
Brr = .Value
.Sort Key1:=.Item(1), Order1:=xlAscending, _
Key2:=.Item(3), Order2:=xlAscending, Header:=xlYes
Arr = .Value
.Value = Brr
End With
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): T2 = Arr(i, 3): T = T1 & T2
If T1 = "" Or T2 = "" Then GoTo i01
If T <> TT Then
N = N + 1: TT = T
For j = 1 To 3: Brr(N + 1, j) = Arr(i, j): Next
Else
Brr(N + 1, 2) = Brr(N + 1, 2) + Arr(i, 2): GoTo i01
End If
i01: Next i
[e2].Resize(N + 1, 3) = Brr
End Sub
|