迴圈耗時的問題

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

2^#

發表於 2019-8-23 01:42 | 只看該作者

爬文許久，還是找不到適用的語法^^"
先以錄製的語法暫用~~如果可以再修減的話，誠請各位大大不吝賜教!謝謝!
'更改文字和底色
Range("AP2:AP127").Select
Application.FindFormat.Interior.ColorIndex = 44
Application.ReplaceFormat.Interior.ColorIndex = 38
Selection.Replace What:="大", Replacement:="小", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
      ReplaceFormat:=True
Application.FindFormat.Interior.ColorIndex = 4
Application.ReplaceFormat.Interior.ColorIndex = 40
Selection.Replace What:="大", Replacement:="小", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
      ReplaceFormat:=True
Application.FindFormat.Interior.ColorIndex = 8
Application.ReplaceFormat.Interior.ColorIndex = 39
Selection.Replace What:="大", Replacement:="小", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
      ReplaceFormat:=True

Range("AX2:BB127").Select
Selection.Replace What:="大", Replacement:="小", LookAt:=xlPart

版主 Rank: 7 Rank: 7 Rank: 7

linyancheng

帖子: 228
主題: 73
精華: 2
積分: 333
點名: 0
作業系統: Windows 10
軟體版本: Office 2000, 2019
閱讀權限: 100
性別: 男
來自: 彰化縣
註冊時間: 2013-7-18
最後登錄: 2024-10-13

3^#

發表於 2019-8-27 18:37 | 只看該作者

迴圈本身次數多，有時也會慢，尤其是對象是儲存格。
有些狀況可以不用迴圈，直接對整個範圍尋找取代，應該會比較快。
IIf本身比較慢，有時候程式碼較簡略，相對執行效率反而較低，把程式碼寫長一點，
Rng.Interior.ColorIndex = IIf(i = 44, 38, IIf(i = 4, 40, IIf(i = 8, 39, i)))
此行展開：
if .....then
elseif ...... then
else
end if
或用Select Case語句也行，
這樣的型式效率應該比較好。

Word呈現極致的靜態之美，Excel展現極致的動態之美。

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

4^#

發表於 2019-8-27 22:00 | 只看該作者

回復 3# linyancheng
謝謝版主指教!我試試看^^

mistery

中學生 Rank: 2

帖子: 82
主題: 5
精華: 0
積分: 115
點名: 0
作業系統: Vista
軟體版本: Office 2003
閱讀權限: 20
性別: 男
來自: Taipei
註冊時間: 2010-5-1
最後登錄: 2023-4-18

5^#

發表於 2019-8-28 12:07 | 只看該作者

「取代」不要用迴圈,會省很多時間
Range("AP2:AP127").Replace What:="大", Replacement:="小"
Range("AX2:BB127").Replace What:="大", Replacement:="小"

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

6^#

發表於 2019-8-28 16:37 | 只看該作者

回復 5# mistery
謝謝大大的指教。

可否再請問 : 底色取代要怎麼寫才正確?
謝謝您^^

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

7^#

發表於 2019-8-28 20:30 | 只看該作者

Dim Ur(3) As Range, Cx%, Cv%, Crr
Crr = Array(0, 38, 40, 39)
.Range("AP2:AP127").Replace "大", "小"
For Each Rng In .Range("AP2:AP127")
Cx = Rng.Interior.ColorIndex
Cv = Switch(Cx = 44, 1, Cx = 4, 2, Cx = 8, 3, Cx = Cx, 0)
If Ur(Cv) Is Nothing Then Set Ur(Cv) = Rng Else Set Ur(Cv) = Union(Ur(Cv), Rng)
For i = 1 To 3
If Not Ur(Cv) Is Nothing Then Ur(Cv).Interior.ColorIndex = Crr(i)
Next i
Next
.Range("AX2:BB127").Replace "小", "大"
[AP2:BC127].Copy [BE2]

是否有快一些, 沒辦法測, 試試吧~~

=================================

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

8^#

發表於 2019-8-29 03:00 | 只看該作者

本帖最後由 ziv976688 於 2019-8-29 03:03 編輯

回復 7# 准提部林
感謝版主的熱心相助。
測試結果 : 沒有受到 For Each Rng In .Range("AP2:AP127")...... Next 的迴圈影響，快很多。
萬分感謝^^

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

9^#

發表於 2019-8-29 10:12 | 只看該作者

回復 8# ziv976688

更正:
Dim Ur(3) As Range, Cx%, Cv%, Crr
Crr = Array(0, 38, 40, 39)
.Range("AP2:AP127").Replace "大", "小"
For Each Rng In .Range("AP2:AP127")
Cx = Rng.Interior.ColorIndex
Cv = Switch(Cx = 44, 1, Cx = 4, 2, Cx = 8, 3, Cx = Cx, 0)
If Ur(Cv) Is Nothing Then Set Ur(Cv) = Rng Else Set Ur(Cv) = Union(Ur(Cv), Rng)
Next
For i = 1 To 3 '這一段要從上方迴圈抓出來
If Not Ur(Cv) Is Nothing Then Ur(Cv).Interior.ColorIndex = Crr(i)
Next i
.Range("AX2:BB127").Replace "小", "大"
[AP2:BC127].Copy [BE2]

帖子: 678
主題: 147
精華: 0
積分: 799
點名: 0
作業系統: win 8
軟體版本: MS 2003
閱讀權限: 50
性別: 男
註冊時間: 2016-2-9
最後登錄: 2022-1-20

10^#

發表於 2019-8-29 11:29 | 只看該作者

回復 9# 准提部林
再次萬分感謝版主的熱心幫忙^^(鞠躬)