Производительность ClearContents и PasteSpecial

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 

Надеюсь, это поможет. :)