Макросы VBA Add / Remove Row запускаются все медленнее при каждом их запуске

Question

У меня есть два простых скрипта, которые запускаются все медленнее каждый раз, когда я их запускаю.Один добавляет строку, другой удаляет строку.Кроме того, все, что делается, - это копирование некоторых форматов, чтобы гарантировать, что таблица по-прежнему выглядит красиво.

Вот проблема: я обнаружил, что если я добавляю строку, удаляю ее, а затем сохраняю xlsm, размер файла увеличивается.Каждый раз, когда я делаю это, кажется, что время выполнения увеличивается до точки, где электронная таблица блокируется на несколько секунд.

Для контекста: calcCOPbottomRow - это строка в электронной таблице Excel.

Все остальные именованные ячейки являются значениями из одной ячейки.

Вот они:

Sub Add_System()

    Call OptimizeCode_Begin

    'Select bottom row of table and insert a new row
    Range("calcCOPbottomRow").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 3
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum + 1) & ":" & CStr(rowNum + 2)).Select
    ActiveSheet.PasteSpecial Format:=4, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

    Call OptimizeCode_End
End Sub

Sub Remove_System()

    If Range("nSystems") <= 1 Then
        MsgBox "Cannot remove final row of COP Calculator Table"
        Exit Sub
    End If

    Call OptimizeCode_Begin

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 2
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum - 1) & ":" & CStr(rowNum)).Select
    ActiveSheet.PasteSpecial Format:=4, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False

    'Delete system row
    Range("calcCOPbottomRow").Offset(-1, 0).Select
    Selection.Delete Shift:=xlUp

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

    Call OptimizeCode_End

End Sub

Есть ли в этом коде что-то, что я не рассматриваю, что вызывает это прогрессивное замедление? Для справки, OptimizeCode_End и OptimizeCode_Start не повлияли на это, но если вам интересно, они здесь:

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xlCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub

Любые советы будут оценены - я довольно новичок в этомвещи.

Спасибо!

Answer 1

Спасибо @dwirony за помощь.Проблема была не в строке вставки / удаления, а в специальной вставке, которую я (тупо) скопировал из макроса записи.Я упростил вставку и удалил весь ненужный код «Выбрать».

Sub Add_System()

    Application.ScreenUpdating = False

    'Select bottom row of table and insert a new row
    Range("calcCOPbottomRow").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 3
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum + 1) & ":" & CStr(rowNum + 2)).PasteSpecial Paste:=xlPasteFormats

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

End Sub

Sub Remove_System()

    If Range("nSystems") <= 1 Then
        MsgBox "Cannot remove final row of COP Calculator Table"
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 2
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum - 1) & ":" & CStr(rowNum)).PasteSpecial Paste:=xlPasteFormats

    'Delete system row
    Range("calcCOPbottomRow").Offset(-1, 0).Delete Shift:=xlUp

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

End Sub