返回列表 上一主題 發帖

迴圈耗時的問題

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 »
發表於 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]

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


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

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
2#
發表於 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]

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題