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

每当我运行VBA添加/删除行宏时，它们的运行速度就会逐渐变慢

1 个答案: