- 帖子
- 2834
- 主題
- 10
- 精華
- 0
- 積分
- 2890
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-23
|
2#
發表於 2018-12-29 10:05
| 只看該作者
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)
|
|
發表於 2018-12-27 22:51
| 
