如何优化VBA代码的性能?

How to optimize the performance of the VBA code?

我在 运行 以下代码中遇到问题。基本上这个想法是对列表进行排序并将唯一记录复制到另一个 sheet。但是由于记录数较多(160000行)。我的代码总是挂起,无法停止计算。

Columns("A:A").Insert Shift:=xlToRight
Range("A1").Value = "Reference2"
Range("A2").Formula = "=B2&F2&N2"
Range("A2").AutoFill Destination:=Range("A2:A160000")

Range("N1").Value = "Day"

Range("N2").Formula = "=DAY(G2)"
Range("N2").AutoFill Destination:=Range("N2:N160000")

Columns("A:N").Select
Selection.Sort Key1:=Range("N2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Columns("A:N").Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Columns("A:N").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


Sheets("Fairbanks Data").Range("A1:N" & Range("B1").End(xlDown).Row).Select
Selection.Copy

Sheets("Fairbanks Data(Edited)").Cells(Rows.Count, "A").End(xlUp).PasteSpecial xlPasteValues
'my code always stopped at here and did the calculation

Sheets("Fairbanks Data").Delete

Sheets("Fairbanks Data(Edited)").Range("A1:A160000").AdvancedFilter     Action:=xlFilterCopy, CopyToRange:=Sheets("Step1Raw").Range("A2"), Unique:=True

有什么办法可以提高速度吗?感谢您的宝贵时间!

VBA 有一些规则可以使您的代码更快。


规则 #1。不要复制和粘贴

复制和粘贴(或PasteSpecial)功能很慢。使用以下复制和粘贴值的速度大约快 25 倍。

Range("A1:Z100").value = Range("A101:Z200").value

如果您这样做,您的代码可能会起作用。如果你在这么多行上这样做,Mamory 可能有问题。


规则#2。计算

通常,Excel 会在单元格或单元格区域的先例发生更改时重新计算该单元格或单元格区域。这可能会导致您的工作簿过于频繁地重新计算,从而降低性能。您可以使用以下语句阻止 Excel 重新计算工作簿:

Application.Calculation = xlCalculationManual

在代码末尾,您可以使用以下语句将计算模式设置回自动:

Application.Calculation = xlCalculationAutomatic

不过请记住,当计算模式为 xlCalculationManual 时,Excel 不会更新单元格中的值。如果您的宏依赖于更新的单元格值,则必须使用 .Calculate 方法强制计算事件,例如 Worksheets(1).Calculate.


规则#3。屏幕更新

VBA 的另一个速度问题是,每次 VBA 将数据写入工作表时,它都会刷新您看到的屏幕图像。刷新图像会严重拖累性能。以下命令关闭屏幕更新。

Application.ScreenUpdating = FALSE

在宏的末尾使用以下命令重新打开屏幕更新。

Application.ScreenUpdating = TRUE

我有这两个潜艇,我倾向于将它们放在我 运行 的任何代码之前和之后。

' 01.
Sub deaktiver()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlCalculationManual
  ' ActiveSheet.DisplayPageBreaks = True 'note this is a sheet-level setting
End Sub
' 02.
Sub reaktiver()
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.DisplayStatusBar = True
  Application.Calculation = xlCalculationAutomatic
  ' ActiveSheet.DisplayPageBreaks = True 'note this is a sheet-level setting
End Sub

显然,您需要知道不同设置的作用,因为某些设置会阻止计算发生或事件触发,正如 Moosli 上面所解释的。

上面代码中的大部分(全部?)内容是我发现的 here,它还涉及许多其他方式来提高您的代码效率。