运行宏后 Excel 动画运行非常缓慢

Question

根据标题，我正在记录一些非常简单的宏，它们应该从一个工作表复制数据，粘贴到另一个工作表，并对第二个工作表的行执行一些简单的操作。

但是，在运行宏（下面的代码）后，excel 变得非常无响应。 甚至滚动浏览文件也会变得很慢。

此外，使用此宏后 CPU 和内存使用率会飙升

我已经录制了宏来自动执行某些任务，但我从未经历过这种减速。

这部分代码将数据从一个工作表复制并粘贴到另一个工作表

Sub Banco_Creazione_Foglio()
'
' Creazione_Foglio_Banco Macro
'

'
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add(After:=ActiveSheet).Name = "Foglio Banco"
ActiveSheet.Paste
Range("A1").Select
End Sub

这部分代码删除了一些不相关的列。

Range("O4").Select
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("G:G").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("G:G,P:P").Select
Range("P1").Activate
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
Columns("G:Q").Select
Selection.Delete Shift:=xlToLeft
Columns("H:I").Select
Selection.Delete Shift:=xlToLeft
Columns("K:L").Select
Selection.Delete Shift:=xlToLeft
Columns("M:Y").Select
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
End Sub

Answer 1

这是你的代码清理了一些东西，如果它有帮助，试试吧：

Option Explicit
Sub Banco_Creazione_Foglio()
'
' Creazione_Foglio_Banco Macro
'

'
    Dim wsSource As Worksheet, wsPaste As Worksheet

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    Set wsSource = ActiveSheet
    Set wsPaste = ThisWorkbook.Sheets.Add(After:=wsSource)
    wsPaste.Name = "Foglio Banco"
    wsSource.UsedRange.Copy wsPaste.Range("A1") 'This is copying everything on your sheet, tell me if you just want to copy some delimited range.
    With wsPaste
        .Columns("G:Q").Delete Shift:=xlToLeft
        .Columns("H:I").Delete Shift:=xlToLeft
        .Columns("K:L").Delete Shift:=xlToLeft
        .Columns("M:Y").Delete Shift:=xlToLeft
        .Columns("N:N").Delete Shift:=xlToLeft
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

End Sub