- 帖子
- 2808
- 主題
- 10
- 精華
- 0
- 積分
- 2864
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-5-10
|
Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TM
TM = Timer
R = [差異!a1].Cells(Rows.Count, 1).End(xlUp).Row - 3
C = [差異!a4].Cells(1, Columns.Count).End(xlToLeft).Column
If R < 2 Or C < 9 Then Exit Sub
'---------------------------------------
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!h1], [Data!a1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
For j = 1 To 6
T = T & "|" & Arr(i, Mid(234517, j, 1))
Next j
xD(T) = xD(T) + Val(Arr(i, 8)): T = ""
Next i
'-------------------------------------
Arr = [差異!a4].Resize(R, C)
ReDim Brr(1 To R - 1, 1 To C - 8)
For i = 2 To R
T = ""
For j = 1 To 5: T = T & "|" & Arr(i, j): Next j
For k = 1 To UBound(Brr, 2)
TT = T & "|" & Arr(1, k + 8)
If xD.Exists(TT) Then Brr(i - 1, k) = xD(TT)
Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub
''大約1秒 |
|
發表於 2021-8-7 09:26
| 
發表於 2021-8-7 08:01
| 
