­ã´£³¡ªL

Sub TEST()
Dim Arr, xD, i&, j&, N&, T$, U&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([RAW!CE1], [RAW!A1].Cells(Rows.Count, 1).End(xlUp))

For i = 2 To UBound(Arr)
    T = Arr(i, 3): If Len(T) <> 13 Then GoTo 101
    T = Left(T, 12) & "X":  U = xD(T)
    If U = 0 Then
       For j = 1 To UBound(Arr, 2): Arr(N + 2, j) = Arr(i, j): Next
       Arr(N + 2, 3) = T: N = N + 1: xD(T) = N: GoTo 101
    End If
    For j = 4 To UBound(Arr, 2)
        Arr(U + 1, j) = Val(Arr(U + 1, j)) + Val(Arr(i, j))
    Next j
101: Next i

With Sheets("After")
     .UsedRange.ClearContents
     If N = 0 Then Exit Sub
     .[A1:CE1].NumberFormatLocal = "@"
     .[A1:CE1].Resize(N + 1) = Arr
End With
End Sub

Xl0000452.rar (68.83 KB)

¤U¸ü¦¸¼Æ: 7

2018-12-29 10:05