如何使我的代码处理时间更短

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