samwang

¦^´_ 1# dou10801
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr, T, T1, i&, n%
Arr = Sheets(1).[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 8)
For i = 5 To UBound(Arr)
    If Arr(i, 1) <> "" Then
        n = n + 1: Brr(n, 1) = Arr(i, 1)
        Brr(n, 2) = Arr(i, 2): Brr(n, 3) = Arr(i, 5)
        Brr(n, 4) = Arr(i, 6): Brr(n, 5) = Arr(i, 7)
        For i2 = i To UBound(Arr)
            If InStr(Arr(i2, 7), "¦X­p") Then
                Brr(n, 7) = Arr(i2, 11): Brr(n, 8) = Arr(i2, 12)
                T = T + Val(Brr(n, 7)): T1 = T1 + Val(Brr(n, 8))
                Exit For
            End If
        Next
    End If
Next
Brr(n + 1, 7) = T: Brr(n + 1, 8) = T1
Sheets(3).[j1].Resize(n + 1, 8) = Brr
End Sub