Question

基本上，我有以下vba代码适用于5000多个行，并且需要花费相当长的时间，我想知道是否有任何方法可以使它运行得更快一些。我基本上是在尝试优化x和y的值，并在每行上运行它们。

预先感谢

Sub maximise(ByRef x As Range, ByRef y As Range)

    Dim ypos1 As Double, ypos2 As Double, yneg1 As Double, yneg2 As Double
    Dim xpos As Double, xneg As Double

    x = 0.01
    ypos1 = y.Value2
    ypos2 = ypos1

    ActiveSheet.Calculate

    Do While ypos2 - ypos1 >= 0
        ypos1 = y.Value2
        xpos = x.Value2
        x.Value2 = x.Value2 + 0.01
        ActiveSheet.Calculate
        ypos2 = y.Value2
    Loop

    ActiveSheet.Calculate

    x = -0.01
    yneg1 = y.Value2
    yneg2 = yneg1

    ActiveSheet.Calculate

    Do While yneg2 - yneg1 >= 0
        yneg1 = y.Value2
        xneg = x.Value2
        x.Value2 = x.Value2 - 0.01
        ActiveSheet.Calculate
        yneg2 = y.Value2
    Loop

    ActiveSheet.Calculate

    If ypos1 > yneg1 Then
        x.Value2 = xpos
    Else
        x.Value2 = xneg
    End If

    ActiveSheet.Calculate

End Sub

Answer 1

在不更改代码的情况下，您可以尝试关闭屏幕更新

    Sub maximise(ByRef x As Range, ByRef y As Range)

Application.ScreenUpdating = False

Dim ypos1 As Double, ypos2 As Double, yneg1 As Double, yneg2 As Double
Dim xpos As Double, xneg As Double

x = 0.01
ypos1 = y.Value2
ypos2 = ypos1

ActiveSheet.Calculate

Do While ypos2 - ypos1 >= 0
   ypos1 = y.Value2
   xpos = x.Value2
   x.Value2 = x.Value2 + 0.01
   ActiveSheet.Calculate
   ypos2 = y.Value2
Loop

ActiveSheet.Calculate

x = -0.01
yneg1 = y.Value2
yneg2 = yneg1

ActiveSheet.Calculate

Do While yneg2 - yneg1 >= 0
   yneg1 = y.Value2
   xneg = x.Value2
   x.Value2 = x.Value2 - 0.01
   ActiveSheet.Calculate
   yneg2 = y.Value2
Loop

ActiveSheet.Calculate

If ypos1 > yneg1 Then
    x.Value2 = xpos
Else
    x.Value2 = xneg
End If

ActiveSheet.Calculate

Application.ScreenUpdating = True

End Sub

如何使我的代码花更少的时间处理？

1 个答案: