iT邦幫忙

0

請大大幫忙優化一個簡單的excel vba sub

各位大大,

我寫了一個簡單的excel vba sub,每次run都要花費一天以上的時間,因為要餵資料給i , j數十萬筆,每筆都需經if判斷條件成立後方可進入worksheets("眾數-1")運算,得出結果再複製到worksheets("眾數-1")內之bd,be,bf欄位,本人是初學者,請教各位大大能否撥冗將我寫的sub優化,縮減運算時間,感恩不盡!!

Sub wsj()
Application.EnableEvents = False
Application.Interactive = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim i, j, k As Integer
k = 1
With Worksheets("眾數-1")
For i = 1 To 300
For j = 30 To 400 - i
.Range("h2") = i
.Range("l2") = j
If .Range("m13") < 3 And .Range("g13") > 9 Then
k = k + 1
.Range("bd" & (k)).Value =.Range("h2")
.Range("be" & (k)).Value =.Range("l2")
.Range("bf" & (k)).Value = .Range("m13")
End If
Next j
Next i
End With
Application.EnableEvents = True
Application.Interactive = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub

2
paicheng0111
iT邦高手 1 級 ‧ 2019-12-06 16:13:24
最佳解答

融合ckp6250的建議加上陣列試試看。
我覺得應該會快很多(我自己的經驗是非常多)。

Sub wsj2()
    Dim i As Long, j As Long
    Dim ary As Variant

    With Worksheets("眾數-1")
        For i = 1 To 300
            .Range("h2") = i
            
            For j = 30 To 400 - i
                .Range("l2") = j
                If .Range("m13") < 3 And .Range("g13") > 9 Then
                    If IsArray(ary) Then
                        ReDim Preserve ary(2, Ubound(ary, 2) + 1) As Variant
                    Else
                        ReDim ary(2, 0) As Variant
                    End If

                    ary(0, Ubound(ary, 2)) = .Range("h2")
                    ary(1, Ubound(ary, 2)) = .Range("l2")
                    ary(2, Ubound(ary, 2)) = .Range("m13")
                End If
            Next j
        Next i
        .Range("bd2").ReSize(Ubound(ary, 2) + 1, 3).Value = Application.Transpose(ary)
    End With
End Sub
看更多先前的回應...收起先前的回應...
ckp6250 iT邦新手 2 級 ‧ 2019-12-06 16:20:29 檢舉

.Range("m13") 和 .Range("g13") 和迴圈沒有任何關係,更應該拉到迴圈外,我剛又修了一下,請您也看一下。

.Range("m13").Range("g13") 和迴圈沒有任何關係,更應該拉到迴圈外,這下省跑好幾萬回。

如果.Range("m13").Range("g13")是跟.Range("l2")有關聯的公式,那就不能拿到迴圈之外了。
因此,我讓它保持在迴圈之內。

ckp6250 iT邦新手 2 級 ‧ 2019-12-06 16:25:35 檢舉

ok

wsj560115 iT邦新手 5 級 ‧ 2019-12-07 21:18:22 檢舉

感謝各位大大的建議,因我是新人被限制無法回應,直到剛剛才能正常使用回應,感恩!

2
海綿寶寶
iT邦大神 1 級 ‧ 2019-12-06 11:15:12

請教一下
m13 和 g13 是用什麼公式
並且引用 h2(=i),i2(=j) 的值計算出來的

如果公式不複雜
可以的話
把該公式整個寫到 VBA 裡面來計算
再把結果寫到 bd,be,bf 去就好了
這樣可以省去一些時間

選我最佳解答

另外
我執行你的程式(完全沒改,只在頭尾加上顯示時間)
筆電跑完只要 20 秒
以此可以推測關鍵在於 m13,g13 的公式複雜度
https://ithelp.ithome.com.tw/upload/images/20191206/20001787hV7KIgm7Kb.png

1
ckp6250
iT邦新手 2 級 ‧ 2019-12-06 11:36:34
m = .Range("m13")
g = .Range("g13")
For i = 1 To 300
    .Range("h2") = i
	For j = 30 To 400 - i		
		.Range("l2") = j		
		If m < 3 And g > 9 Then
			k = k + 1
			.Range("bd" & (k)).Value = i
			.Range("be" & (k)).Value = j
			.Range("bf" & (k)).Value = m
		End If
	Next j
Next i

既然 .Range("h2") = i,那麼,就應拉到第一層迴圈,而不應擺在第二層,可以少執行數百回。

.Range("m13") 和 .Range("g13") 和迴圈沒有任何關係,更應該拉到迴圈外,這下省跑好幾萬回。

又 .Range("h2") = i ,
那麼,原程式的 .Range("bd" & (k)).Value =.Range("h2"),就沒道理了,
應該直接用 .Range("bd" & (k)).Value = i 才能節省資源
.Range() 是物件,i 是變數,存取物件比較耗費資源,
資料少還好,資料若多,能省則省。

又,下回程式請縮排。

縮排很重要!!!!!

.Range("m13").Range("g13") 和迴圈沒有任何關係,更應該拉到迴圈外,這下省跑好幾萬回。

如果.Range("m13").Range("g13")是跟.Range("l2")有關聯的公式,那就不能拿到迴圈之外了。

縮排可以減少對自己眼睛的傷害 /images/emoticon/emoticon30.gif
/images/emoticon/emoticon46.gif腦子也是

我要發表回答

立即登入回答