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

Excel在冻结VBA公式期间冻结（200,000行+）

2 个答案: