Excel在VBA公式复制期间冻结(200,000行+)

Question

我对 VBA 相当陌生，所以我有一个基本代码，我正在为我的很多模板使用它，它们工作得很好，但由于这个有超过 200,000 行并且宏冻结或需要 20 分钟才能完成。 你知道有什么想法或任何我如何让它更快而不冻结的东西吗？

宏在这里(只需从一列中删除尾随空格，然后将第一行中的所有公式向下拖动到特定列 D 的最后一行(

我可以向我的 VBA 代码添加任何内容以加快速度，还是由于行中有大量数据，这始终是一个问题？ 非常感谢您的帮助

Sub Fill_formulas_Click() 
Dim LR As Long
Columns("E:E").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False 
LR = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
Range("A2").AutoFill Destination:=Range("A2:A" & LR)
Range("B2").AutoFill Destination:=Range("B2:B" & LR)
Range("C2").AutoFill Destination:=Range("C2:C" & LR)
Range("N2").AutoFill Destination:=Range("N2:N" & LR)
Range("O2").AutoFill Destination:=Range("O2:O" & LR)
Range("P2").AutoFill Destination:=Range("P2:P" & LR)
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LR)
Range("R2").AutoFill Destination:=Range("R2:R" & LR)
Range("S2").AutoFill Destination:=Range("S2:S" & LR)
Range("T2").AutoFill Destination:=Range("T2:T" & LR)
Range("U2").AutoFill Destination:=Range("U2:U" & LR)
End Sub

Answer 1

要尝试的一件事是在开始之前关闭屏幕更新和计算：

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

*your_routines*
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

如果工作表中可能Event Code处于活动状态，则还应将其关闭：

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
*your_code*
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With

Answer 2

除了 Ron Rosenfeld 提供的内容之外，还可以将代码简化为以下内容以减少执行的操作量(屏幕更新代码位于Dim LR as Long语句之前(：

Sub Fill_formulas_Click()
Dim LR As Long
LR = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
Range("E1:E" & LR).Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A2:C2").AutoFill Destination:=Range("A2:C" & LR)
Range("N2:P2").AutoFill Destination:=Range("N2:U" & LR)
End Sub