返回列表 上一主題 發帖

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

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
1# 跳轉到 »
發表於 2023-5-30 13:23 | 顯示全部帖子
本帖最後由 Andy2483 於 2023-5-30 13:48 編輯

回復 5# 准提部林


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導

執行前:


執行結果:



Sub 比較2()
Dim Arr, Brr, xD, i&
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
Arr = Range([day1!Q1], [day1!A65536].End(xlUp))
'↑令Arr變數是 二維陣列,以 "day1"表A~Q欄儲存格值帶入陣列中
For i = 2 To UBound(Arr)
'↑設順迴圈
    xD(Arr(i, 2) & Arr(i, 5) & Arr(i, 14) & Arr(i, 15)) = Val(Arr(i, 8))
    '↑令第(2,5,14,15)欄陣列值組成的新字串當key,item是 8欄陣列值轉數值
Next i
Arr = Range([day2!Q1], [day2!A65536].End(xlUp))
'↑令Arr陣列換裝 "day2"表A~Q欄儲存格值
ReDim Brr(1 To UBound(Arr), 1 To 2)
'↑宣告Brr變數是 二維空陣列,縱向範圍同Arr陣列,橫向範圍1~2
Brr(1, 1) = "昨日": Brr(1, 2) = "差異"
'↑令Brr陣列第1列是標題列
For i = 2 To UBound(Arr)
'↑設順迴圈!
    Brr(i, 1) = Val(xD(Arr(i, 2) & Arr(i, 5) & Arr(i, 14) & Arr(i, 15)))
    '↑令Brr第1欄迴圈陣列值是 以第(2,5,14,15)欄陣列值組成的新字串,查
    '查xD字典回傳item值轉數值
    If Val(Arr(i, 8)) > Brr(i, 1) Then Brr(i, 2) = "增加"
    '↑如果第8欄Arr迴圈陣列值轉數值 大於 Brr1欄陣列值,
    '就令Brr第2欄陣列值以 "增加"字串 寫入
Next i
[day2!R1:S1].Resize(UBound(Arr)) = Brr
'↑令Brr陣列值從 "day2"表[R1]開始寫入儲存格中
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
2#
發表於 2023-5-30 14:34 | 顯示全部帖子
謝謝論壇,謝謝各位前輩
後學藉此帖學習以前輩的方案改成一個陣列處理的方案,學習方案如下,請各位前輩指教

Sub TEST()
Dim Brr, Y, i&, Sh1 As Worksheet, Sh2 As Worksheet
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Set Sh1 = Sheets("day1"): Set Sh2 = Sheets("day2")
'↑令Sh1變數是 名為 "day1"的工作表,令Sh2變數是 名為 "day2"的工作表
Brr = Range(Sh1.[Q1], Sh1.[A65536].End(3))
'↑令Brr變數是 二維陣列,以Sh1工作表A~Q欄儲存格值帶入陣列中
For i = 2 To UBound(Brr)
'↑設順迴圈
   Y(Brr(i, 2) & Brr(i, 5) & Brr(i, 14) & Brr(i, 15)) = Val(Brr(i, 8))
   '↑令第(2,5,14,15)欄陣列值組成的新字串當key,item是 第8欄陣列值轉數值
Next
Brr = Range(Sh2.[Q2], Sh2.[A65536].End(3))
'↑令Brr陣列換裝 Sh1工作表A~Q欄儲存格值(不含標題列)
For i = 1 To UBound(Brr)
'↑設順迴圈
   Brr(i, 1) = Val(Y(Brr(i, 2) & Brr(i, 5) & Brr(i, 14) & Brr(i, 15)))
   '↑令Brr第1欄迴圈陣列值是 以第(2,5,14,15)欄陣列值組成的新字串,查
    '查Y字典回傳item值轉數值(以結果值覆蓋原陣列值)
   If Val(Brr(i, 8)) > Brr(i, 1) Then Brr(i, 2) = "增加" Else Brr(i, 2) = ""
   '↑如果第8欄Brr迴圈陣列值轉數值 大於 Brr第1欄陣列值,
    '就令Brr第2欄陣列值以 "增加"字串 寫入,否則就讓空白
Next
Sh2.[R2].Resize(UBound(Brr), 2) = Brr: Sh2.[R1:S1] = [{"昨日","差異"}]
'↑令Brr陣列值從Sh2表[R2]寫入儲存格中,令[R1:S1]寫入列標題
Set Y = Nothing: Set Sh1 = Nothing: Set Sh2 = Nothing: Erase Brr
'↑令釋放變數
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 要比誰更受誰．不要比誰更怕誰。
返回列表 上一主題