Question

在Excel VBA中，我需要清除一个非常大的命名范围的内容（但不是格式），然后将其中的一部分粘贴到从不同命名范围中获取的公式中。问题是清除然后粘贴操作的性能。它们很慢。然而，在纸张上手动执行的相同操作明显更快。工作表始终处于手动计算模式。以下是我为此编写的代码：

Sub loadFormuals_(nm_rng_formula As String, nm_rng_control As String, nm_rng_paste As String, nm_rng_clear As String)
Dim rAbs As Integer
Dim rRel As Integer

Dim rng_formula As Range: Set rng_formula = Range(nm_rng_formula)
Dim rng_control As Range: Set rng_control = Range(nm_rng_control)
Dim rng_paste As Range: Set rng_paste = Range(nm_rng_paste)
Dim rng_clear As Range: Set rng_clear = Range(nm_rng_clear)
Application.ScreenUpdating = False
Application.EnableEvents = False


Dim ws As Worksheet
Set ws = Worksheets(rng_paste.Worksheet.Name)
ws.EnableCalculation = False
rng_clear.ClearContents


If Not (IsEmpty(rng_control.Cells(1, 1))) Then
    Application.ScreenUpdating = False
    rAbs = rng_control.End(xlDown).Row
    rRel = rAbs - rng_control.Cells(1, 1).Row + 1
    rng_formula.Copy
    ws.Range(rng_paste.Cells(1, 1), rng_paste.Cells(rRel, 1)).PasteSpecial Paste:=xlPasteFormulas
    Application.CutCopyMode = False
End If
Application.EnableEvents = True
ws.EnableCalculation = True
End Sub

此处nm_rng_clear是需要清除的范围的字符串名称，nm_rng_formula是包含公式的范围的名称，范围nm_rng_control和nm_rng_paste控制粘贴公式的位置。

缓慢的部分是：

rng_clear.ClearContents

和：

ws.Range(rng_paste.Cells(1, 1), rng_paste.Cells(rRel, 1)).PasteSpecial Paste:=xlPasteFormulas

我能做些什么来加快这个速度吗？

Answer 1

我已经稍微更新了代码，我认为它会更好一点，但很难说。可能会减慢工作簿速度的是使用整列的大型参考公式：VLOOKUP，MATCH ...或者在极少数情况下条件= IF（A：A = 2，A：AB：B，A：A * C：C ）

Option Explicit

Sub loadFormuals_(ByVal nm_rng_formula As String, _
                  ByVal nm_rng_control As String, _
                  ByVal nm_rng_paste As String, _
                  ByVal nm_rng_clear As String)

    Dim rAbs As Integer
    Dim rRel As Integer
    Dim strFormula As String

    Call TurnExtrasOff

    Dim rng_formula As Range: Set rng_formula = Range(nm_rng_formula)
    Dim rng_control As Range: Set rng_control = Range(nm_rng_control)
    Dim rng_paste As Range: Set rng_paste = Range(nm_rng_paste)
    Dim rng_clear As Range: Set rng_clear = Range(nm_rng_clear)


    Dim ws As Worksheet
    Set ws = Worksheets(rng_paste.Worksheet.Name)
    strFormula = rng_formula.Resize(1, 1).Formula

    'Clear the range
    rng_clear.Value = vbNullString

    ' Paste the formulas
    If Not (IsEmpty(rng_control.Cells(1, 1))) Then
        rAbs = rng_control.End(xlDown).Row
        rRel = rAbs - rng_control.Cells(1, 1).Row + 1
        ws.Range(rng_paste.Cells(1, 1), rng_paste.Cells(rRel, 1)).Formula = strFormula
    End If

    Call TurnExtrasOn

End Sub

Sub TurnExtrasOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub

Sub TurnExtrasOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

希望这会有所帮助。：）

＆＃39; clearContents中＆＃39;和＆＃39; PasteSpecial＆＃39;性能

1 个答案: