另一种替代 do-until 循环的方法，使代码执行速度更快

Question

我需要有关如何使我的代码执行得更快的帮助。我的数据量非常大，我的“

Do Until loop

”导致执行速度缓慢。我想知道是否有办法让我的代码运行得更快。我只使用了 do Until 循环，因为我对此很满意。谢谢

Dim WB1 As Workbook
Dim ws1 As Worksheet
Dim last As Long
Dim i As Integer
Dim x As String, y As String

Set WB1 = ThisWorkbook
Set ws1 = WB1.Worksheets("Source")

last = ws1.Cells(Rows.Count, "X").End(xlUp).Row

i = 2
Do Until Sheets("Source").Cells(i, 1) = ""
    x = Left(Sheets("Source").Cells(i, 6), 3)
    y = Left(Sheets("Source").Cells(i, 23), 7)
    If x = "611" Or y = "INITIAL" Then

        Sheets("Source").Cells(i, 25) = "INITIAL"

    Else

        ws1.Range("Y2:Y" & last).Formula = "=VLOOKUP(A:A,'Assignment Reference'!$C:$E,3,FALSE)"

    End If

    i = i + 1
Loop

Answer 1

有很多可能的方法来提高 Excel 的 VBA 代码的性能。最好的情况是你读过一些相关文章：

• Excel VBA 性能编码最佳实践
• 优化VBA

---

编辑： 正如 Bond 所建议的，我在 VBA 代码中做了以下操作来提高执行性能：

Option Explicit

Dim screenUpdating As Boolean
Dim calculation As XlCalculation
Dim enableEvents As Boolean
Dim displayPageBreaks As Boolean



' Freezes Excel into its current state to improve
' performance during executing macro code. Be sure
' to call DoEvents occasionally during execution to
' prevent completly freezing the Excel window.
' Call this routine before all other code but after
' setting up proper exception handling.
Public Sub freezeSystem()
    'Save Excel configuration to reset later
    screenUpdating = Application.screenUpdating
    calculation = Application.calculation
    enableEvents = Application.enableEvents
    displayPageBreaks = ActiveSheet.displayPageBreaks

    'Turn off some Excel functionality so your code runs faster
    Application.screenUpdating = False
    Application.calculation = xlCalculationManual
    Application.enableEvents = False
    ActiveSheet.displayPageBreaks = False 'Note this is a sheet-level setting, but only necessary for ActiveSheet if code do not change the ActiveSheet
End Sub




' Unfreezes Excel and resets it into the configuration it had
' before the freezeSystem() was executed.
' Call this routine at the end of the macro code and also during
' the cleanup of exception handling.
Public Sub defreezeSystem()
    ' Reset Excel configuration into previous state
    Application.screenUpdating = screenUpdating
    Application.calculation = calculation
    Application.enableEvents = enableEvents
    ActiveSheet.displayPageBreaks = displayPageBreaks 'Note this is a sheet-level setting, but only necessary for ActiveSheet if code do not change the ActiveSheet

    ' Perform recalculation of all formulas
    Application.CalculateFullRebuild
End Sub




' This routine is intended to update the Excel window
' while executing macro code in controlled manner if
' necessary. Be aware that calling this function too
' often will drastically reduce the execution performance.
Public Sub updateSystem()
    If Application.screenUpdating = False Then
        Application.screenUpdating = True
        Application.CalculateFullRebuild
        Application.screenUpdating = False
    Else
        Application.CalculateFullRebuild
    End If
End Sub

在代码开头或代码处调用

freezeSystem()

以提高执行期间的性能。在代码末尾调用

defreezeSystem()

，并在必要时在异常处理期间进行清理。

我是这样做的：

Sub entryPoint()
    On Error GoTo entryPointErrorHandler    ' set up exception handling
    freezeSystem
    [your regular code goes here]

entryPointCleanUp:                          ' clean up from exception and normal operation
    [your cleanup code goes here]
    defreezeSystem
    Exit Sub

entryPointErrorHandler:                     ' exception handling
    [your exception handling code goes here]
    GoTo entryPointCleanUp                  ' jump to clean up code

End Sub

Answer 2

加快速度的一种方法是告诉 Excel 不要费心更新屏幕或计算单元格。在循环之前关闭它们并在循环之后打开它们：

'***** Before loop
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'***** After loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Answer 3

尝试使用您已经设置的参考。例如：代替

Do Until Sheets("Source").Cells(i, 1) = ""
x = Left(Sheets("Source").Cells(i, 6), 3)
y = Left(Sheets("Source").Cells(i, 23), 7)

使用

Do Until Sheets("Source").Cells(i, 1) = ""
   x = Left(ws1.Cells(i, 6), 3)
   y = Left(ws1.Cells(i, 23), 7)

我也会尽量避免

VLOOKUP

，这非常慢。如果您需要的只是检查某个范围内是否存在 a 值，

COUNTIF

速度要快得多。

Answer 4

你也可以通过定时器功能来查看，来分析你的代码慢了多少

订阅你的订阅()

开始 = 计时器

' 你的整个代码在这里 。 。 .

MsgBox(定时器-启动) 结束子

使用Application.Calculation = xlCalculationManual

我将代码改进了 70% 以上