- 帖子
- 2833
- 主題
- 10
- 精華
- 0
- 積分
- 2889
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-11-17
|
9#
發表於 2021-8-7 19:41
| 只看該作者
Sub TEST_A1()
Dim Arr, Brr, xD, R&, C%, i&, j%, k%, T$, TT$, TS$(2), TC$, 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 4: T = T & "|" & Arr(i, j): Next j
For k = 1 To UBound(Brr, 2)
TT = T & "|" & Arr(i, 5) & "|" & Arr(1, k + 8)
TC = T & "|差異" & "|" & Arr(1, k + 8)
If xD.Exists(TT) Then
Brr(i - 1, k) = xD(TT): xD(TC) = ""
For j = 1 To 2: TS(j) = T & "|版本" & j & "|" & Arr(1, k + 8): Next j
End If
If Arr(i, 5) = "差異" Then
If xD.Exists(TC) Then Brr(i - 1, k) = xD(TS(2)) - xD(TS(1))
End If
Next k
Next i
'-------------------------------------
[差異!i5].Resize(R - 1, C - 8) = Brr
Arr = "": Brr = "": Set xD = Nothing
MsgBox Timer - TM
End Sub
'差異 = 版本2 - 版本1 ???
=========================== |
|
發表於 2021-8-6 23:10
| 
發表於 2021-8-7 04:36
| 
