分享一些关于VBA代码优化提速的资料

老伙计2008 · 发表于 2009-12-18 16:38

原帖由 Moneky 于 2009-12-10 12:05 发表

在这段代码中是不能省略，主要是因为逻辑运算符的优先级低于算术运算符。前面帖子中说的可获可以省略是特指那里所举的例子的。

你说的多重判断是这样么？

Private Sub test()
Dim a As Long , b As Long ...

我所说的多重判断是指IF嵌套。如下例，套在百万次的循环里，速度很慢。不知道能这些代码能否优化。

         If bHappy(i) > 0 Then
            WinningCount = WinningCount + 1
            If FailureCount > 0 Then
                  barrFailure(FailureCount) = barrFailure(FailureCount) + 1
                  FailureCount = 0
            End If
         Else
            FailureCount = FailureCount + 1
            If WinningCount > 0 Then
                  barrWinning(WinningCount) = barrWinning(WinningCount) + 1
                  WinningCount = 0
            End If
         End If
      Next

Moneky · 发表于 2009-12-18 20:09

原帖由 老伙计2008 于 2009-12-18 16:38 发表

我所说的多重判断是指IF嵌套。如下例，套在百万次的循环里，速度很慢。不知道能这些代码能否优化。

         If bHappy(i) > 0 Then
            WinningCount = WinningCount + 1
            If ...

用你的代码片段写了个测试程序

Sub test()
Dim bHappy(1000000) As Long
Dim barrFailure(1000000) As Long
Dim barrWinning(1000000) As Long
Dim WinningCount As Long, FailureCount As Long, i As Long
Randomize
For i = 0 To 1000000
bHappy(i) = CLng(Rnd * 1000000) - CLng(Rnd * 1000000)
Next
Dim t As Single
t = Timer
For i = 0 To 1000000
WinningCount = WinningCount - (bHappy(i) > 0)
barrFailure(FailureCount) = barrFailure(FailureCount) - (bHappy(i) > 0 And FailureCount > 0)
FailureCount = IIf(bHappy(i) > 0 And FailureCount > 0, 0, FailureCount)
FailureCount = FailureCount - (bHappy(i) <= 0)
barrWinning(WinningCount) = barrWinning(WinningCount) - (bHappy(i) <= 0 And WinningCount > 0)
WinningCount = IIf(bHappy(i) <= 0 And WinningCount > 0, 0, barrWinning(WinningCount))
Next
t = Timer - t
MsgBox CStr(t)
End Sub
Sub test2()
Dim bHappy(1000000) As Long
Dim barrFailure(1000000) As Long
Dim barrWinning(1000000) As Long
Dim WinningCount As Long, FailureCount As Long, i As Long
Randomize
For i = 0 To 1000000
bHappy(i) = CLng(Rnd * 1000000) - CLng(Rnd * 1000000)
Next
Dim t As Single
t = Timer
For i = 0 To 1000000
If bHappy(i) > 0 Then
WinningCount = WinningCount + 1
If FailureCount > 0 Then
barrFailure(FailureCount) = barrFailure(FailureCount) + 1
FailureCount = 0
End If
Else
FailureCount = FailureCount + 1
If WinningCount > 0 Then
barrWinning(WinningCount) = barrWinning(WinningCount) + 1
WinningCount = 0
End If
End If
Next
t = Timer - t
MsgBox CStr(t)
End Sub

复制代码

test2明显快于test，主要是因为test2中判断的参数少很多，而test中要判断很多次，效率自然就低了。而且test中的代码晦涩难懂，所以这种情况下，应该不适合将代码写成test那种模样

老伙计2008 · 发表于 2009-12-18 21:13

楼主辛苦了，谢谢！让我长了不少见识

老伙计2008 · 发表于 2009-12-19 01:05

楼主如果有时间帮我看一下这个帖子。这个帖子是与我在79楼的的回复相关的。谢谢！
同样循环1000万次，速度为什么不一样？

YZLSZAJ · 发表于 2009-12-19 06:35

谢谢楼主分享

老伙计2008 · 发表于 2009-12-19 20:06

学习了好久，有很多东西还是理解不透，不知道一下代码能否进行优化。先谢了！
说明：所有变量均为Byte型

If X1 = Y1 Or X1 = Y2 Or X1 = Y3 Or X1 = Y4 Or X1 = Y5 Or X1 = Y6 _
Or X2 = Y1 Or X2 = Y2 Or X2 = Y3 Or X2 = Y4 Or X2 = Y5 Or X2 = Y6 _
Or X3 = Y1 Or X3 = Y2 Or X3 = Y3 Or X3 = Y4 Or X3 = Y5 Or X3 = Y6 _
Or X4 = Y1 Or X4 = Y2 Or X4 = Y3 Or X4 = Y4 Or X4 = Y5 Or X4 = Y6 _
Or X5 = Y1 Or X5 = Y2 Or X5 = Y3 Or X5 = Y4 Or X5 = Y5 Or X5 = Y6 _
Or X6 = Y1 Or X6 = Y2 Or X6 = Y3 Or X6 = Y4 Or X6 = Y5 Or X6 = Y6 Then

复制代码

Moneky · 发表于 2009-12-19 23:58

先前的回复不正确，删除之

[ 本帖最后由 Moneky 于 2009-12-20 00:02 编辑 ]

Moneky · 发表于 2009-12-20 00:20

原帖由 老伙计2008 于 2009-12-19 20:06 发表
学习了好久，有很多东西还是理解不透，不知道一下代码能否进行优化。先谢了！
说明：所有变量均为Byte型If X1 = Y1 Or X1 = Y2 Or X1 = Y3 Or X1 = Y4 Or X1 = Y5 Or X1 = Y6 _
Or X2 = Y1 Or X2 ...

可以这样写（test2）：

Sub test1()
Dim x1 As Byte, x2 As Byte, x3 As Byte, x4 As Byte, x5 As Byte, x6 As Byte
Dim y1 As Byte, y2 As Byte, y3 As Byte, y4 As Byte, y5 As Byte, y6 As Byte
x1 = 0: y1 = 0
x2 = 0: y2 = 0
x3 = 0: y3 = 0
x4 = 0: y4 = 0
x5 = 0: y5 = 0
x6 = 0: y6 = 0
Dim i As Long
Dim j As Long
Dim t As Single
i = 0: j = 0
t = Timer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For j = 1 To 1000000
If x1 = y1 Or x1 = y2 Or x1 = y3 Or x1 = y4 Or x1 = y5 Or x1 = y6 _
Or x2 = y1 Or x2 = y2 Or x2 = y3 Or x2 = y4 Or x2 = y5 Or x2 = y6 _
Or x3 = y1 Or x3 = y2 Or x3 = y3 Or x3 = y4 Or x3 = y5 Or x3 = y6 _
Or x4 = y1 Or x4 = y2 Or x4 = y3 Or x4 = y4 Or x4 = y5 Or x4 = y6 _
Or x5 = y1 Or x5 = y2 Or x5 = y3 Or x5 = y4 Or x5 = y5 Or x5 = y6 _
Or x6 = y1 Or x6 = y2 Or x6 = y3 Or x6 = y4 Or x6 = y5 Or x6 = y6 Then i = i + 1
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
t = Timer - t
MsgBox CStr(t) & " i=" & CStr(i)
End Sub
'-----------------------------------------------------------------------------------------------------------
Sub test2()
Dim x1 As Byte, x2 As Byte, x3 As Byte, x4 As Byte, x5 As Byte, x6 As Byte
Dim y1 As Byte, y2 As Byte, y3 As Byte, y4 As Byte, y5 As Byte, y6 As Byte
x1 = 0: y1 = 0
x2 = 0: y2 = 0
x3 = 0: y3 = 0
x4 = 0: y4 = 0
x5 = 0: y5 = 0
x6 = 0: y6 = 0
Dim i As Long
Dim j As Long
Dim t As Single, ck As Boolean
i = 0: j = 0
t = Timer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For j = 1 To 1000000
ck = False
'下面的代码和test1不等价，是错误程序
If x1 = y1 Then
ck = True
ElseIf x2 = y2 Then
ck = True
ElseIf x3 = y3 Then
ck = True
ElseIf x4 = y4 Then
ck = True
ElseIf x5 = y5 Then
ck = True
ElseIf x6 = y6 Then
ck = True
End If
If ck Then i = i + 1
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
t = Timer - t
MsgBox CStr(t) & " i=" & CStr(i)
End Sub

复制代码

在我的电脑上 test1在任何情况下耗时稳定在 2.2s左右
test2在x1-x6 与y1-y6两两相等的时候耗时约0.26s，在极端的情况下（两两不相等）耗时0.5s左右
总体来说test2比test1快4倍左右。

刚刚楼上的回帖我采用的是用数组储存那12个变量，然后用双循环判断是否相等，如果遇到相等则退出循环，确认条件成立，结果一开始我测试的数据是12个变量两两相等的情况，耗时大约0.53s左右，当时急急忙忙回帖，回完了之后才发现测试的有问题，于是马上弄了个两两不相等的情况测试，发现在极端情况下，效率极低，耗时居然达到了7.2s左右

所以接着有帮上楼给删了，重新像本楼这样写。

此楼结果仍然错误！

[ 本帖最后由 Moneky 于 2009-12-20 01:37 编辑 ]

老伙计2008 · 发表于 2009-12-20 01:09

首先表示感谢

说明一下：
X和Y本来是两个数组，为了提高速度把数组替换为一般BYTE型变量（优化一次）。另外重点需要说明的是两个数组之间并不存在对应关系，只要数组X中任意一个元素与数组Y中任意一个元素相等就算成立，这也是我原来代码表达的含义。
如果我没有理解错的话，楼主给出的代码是按对应关系判断，这样的判断偏离了题意，会产生错误的结果。不知道我理解的是否正确

对于布尔运算在计算机内部是如何操作的，我一无所知，所以楼主前面的优化代码，我基本上不理解

，也不知道如何套用。

所以请楼主多多支持。
我原来的程序运行一次42分钟，通过吸取楼主的优化措施已经缩短到15分钟。我在84楼提出的需要优化的代码，是程序中调用最频繁的部分，消耗的时间最多(经过1次优化后还占总时间的80%以上)，不知道能否再优化。请楼主指点！

[ 本帖最后由老伙计2008 于 2009-12-20 01:17 编辑 ]

Moneky · 发表于 2009-12-20 01:42

原帖由 老伙计2008 于 2009-12-20 01:09 发表
首先表示感谢
说明一下：
X和Y本来是两个数组，为了提高速度把数组替换为一般BYTE型变量（优化一次）。另外重点需要说明的是两个数组之间并不存在对应关系，只要数组X中任意一个元素与数组Y中任意 ...

86楼的代码确实是错误的，是我疏忽了。我觉得你的问题可以看成判断两个数组是否有交集的问题，数组元素少的话照你原来那样写，或者是把86楼的代码多写几行还可行，但如果数组太大的话，目前我能想到的办法还只是85楼原来的双层循环来判断。不过这样速度还是不如人意，让我们一起再想想办法吧。

		自动登录	找回密码
密码			免费注册

[分享] 分享一些关于VBA代码优化提速的资料