返回列表 上一主題 發帖

[發問] 巨集執行緩慢改善

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 »
發表於 2018-4-22 10:57 | 顯示全部帖子
Sub 比較()
Dim xRow1&, xRow2&, xTT$
[day2!R1] = "昨日":   [day2!S1] = "差異"
'↓R欄公式的〔預設公式字串〕
xTT = "=SUMPRODUCT((B2=day1!B$2:B$//)*(day2!E2=day1!E$2:E$//)*(day2!N2=day1!N$2:N$//)*(day2!O2=day1!O$2:O$//),day1!H$2:H$//)"

xRow1 = [day1!A65536].End(xlUp).Row
xRow2 = [day2!A65536].End(xlUp).Row
'↓將〔預設公式字串〕中的〔//〕替換為實際〔day1〕最後一列號，填入Ｒ欄
[day2!R2].Resize(xRow2 - 1) = Replace(xTT, "//", xRow1)
[day2!S2].Resize(xRow2 - 1) = "=IF(H2-R2>0,""增加"","""")"
End Sub

會緩慢是因為公式〔全欄引用〕，資料只有５００筆左右，限定參照範圍即可！
若資料筆數真的很多，可改用字典檔及ARRAY

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
2#
發表於 2018-4-22 15:56 | 顯示全部帖子
回復 3# iamaraymond
  1. Sub 比較2()
  2. Dim Arr, Brr, xD, i&
  3. Set xD = CreateObject("Scripting.Dictionary")
  4. Arr = Range([day1!Q1], [day1!A65536].End(xlUp))
  5. For i = 2 To UBound(Arr)
  6.     xD(Arr(i, 2) & Arr(i, 5) & Arr(i, 14) & Arr(i, 15)) = Val(Arr(i, 8))
  7. Next i

  9. Arr = Range([day2!Q1], [day2!A65536].End(xlUp))
  10. ReDim Brr(1 To UBound(Arr), 1 To 2)
  11. Brr(1, 1) = "昨日": Brr(1, 2) = "差異"
  12. For i = 2 To UBound(Arr)
  13.     Brr(i, 1) = Val(xD(Arr(i, 2) & Arr(i, 5) & Arr(i, 14) & Arr(i, 15)))
  14.     If Val(Arr(i, 8)) > Brr(i, 1) Then Brr(i, 2) = "增加"
  15. Next i

  17. [day2!R1:S1].Resize(UBound(Arr)) = Brr
  18. End Sub
複製代碼

TOP

        靜思自在 : 人生沒有所有權，只有生命的使用權。
返回列表 上一主題