即使事件已關閉，Excel VBA代碼運行也非常緩慢

以下是我的一些同事已經用來清理Excel文檔的宏。這是一個完整的混亂！信不信由你，這是我清理過的版本（我刪除了大量的活動窗口滾動，一次又一次調整列寬和行寬）。即使在我清理完畢（並關閉事件）後，此代碼仍然運行緩慢（10-15秒），並在整個頁面上滾動。任何想法，我怎麼修改這個來運行它快一點？即使事件已關閉，Excel VBA代碼運行也非常緩慢

Sub MyMacro() 
Application.DisplayAlerts = False 
    Sheets("P H T Funnel Summary_1").Select 
    ActiveWindow.SelectedSheets.Delete 
    Rows("1:21").Select 
     Selection.ClearContents 
     Selection.Delete Shift:=xlUp 
'Joyce's Macro 
    Rows("1:1").RowHeight = 51 
    Rows("1:1").RowHeight = 44.25 
    Range("A1").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlTop 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Columns("F:F").Select 
    Selection.Cut 
    Columns("B:B").Select 
    ActiveSheet.Paste 
    Selection.ColumnWidth = 14.29 
    Columns("B:B").Select 
    With Selection 
     .HorizontalAlignment = xlGeneral 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Columns("G:G").Select 
    Selection.Cut 
    Columns("C:C").Select 
    ActiveSheet.Paste 
    Range("D1").Select 
    ActiveCell.FormulaR1C1 = "Quote Account Name" 
    Range("D1").Select 
    With Selection 
     .HorizontalAlignment = xlGeneral 
     .VerticalAlignment = xlTop 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Selection.Font.Bold = True 
    Range("D1:D534").Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlThin 
    End With 
    Columns("AB:AB").Select 
    Selection.Cut 
    Columns("E:E").Select 
    ActiveSheet.Paste 
    Columns("K:K").Select 
    Selection.Cut 
    Columns("G:G").Select 
    ActiveSheet.Paste 
    Columns("G:G").Select 
    With Selection 
     .HorizontalAlignment = xlGeneral 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("H1").Select 
    Columns("L:L").Select 
    Selection.Cut 
    Columns("H:H").Select 
    ActiveSheet.Paste 
    Columns("H:H").EntireColumn.AutoFit 
    Columns("I:I").Select 
    Selection.Cut 
    Columns("I:I").Select 
    Application.CutCopyMode = False 
    Selection.Delete Shift:=xlToLeft 
    Selection.ColumnWidth = 12.29 
    With Selection 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Columns("AN:AN").Select 
    Selection.Cut 
    Columns("J:J").Select 
    ActiveSheet.Paste 
    Selection.ColumnWidth = 16 
    With Selection 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Columns("AI:AI").Select 
    Selection.Cut 
    Columns("K:K").Select 
    ActiveSheet.Paste 
    Range("K1").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlTop 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("L1").Select 
    ActiveCell.FormulaR1C1 = " " 
    Columns("AJ:AJ").Select 
    Selection.Cut 
    Columns("L:L").Select 
    ActiveSheet.Paste 
    Columns("M:M").Select 
    Selection.Cut 
    Application.CutCopyMode = False 
    Selection.Delete Shift:=xlToLeft 
    Range("N1").Select 
    Selection.ClearContents 
    Columns("X:X").Select 
    Selection.Cut 
    Range("N1").Select 
    ActiveSheet.Paste 
    Range("O1").Select 
    Columns("N:N").EntireColumn.AutoFit 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlTop 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("N1").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlTop 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("O1").Select 
    ActiveCell.FormulaR1C1 = " " 
    Columns("U:U").Select 
    Selection.Cut 
    Columns("O:O").Select 
    ActiveSheet.Paste 
    Columns("Y:Y").Select 
    Selection.Cut 
    Columns("O:O").Select 
    Selection.Insert Shift:=xlToRight 
    Range("O1").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlTop 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("P1").Select 
    Columns("X:X").Select 
    Selection.Cut 
    Columns("Q:Q").Select 
    Selection.Insert Shift:=xlToRight 
    Range("Q1").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlTop 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Columns("T:T").Select 
    Selection.Cut 
    Columns("R:R").Select 
    Columns("T:T").Select 
    Application.CutCopyMode = False 
    Selection.Cut 
    Columns("R:R").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("R:R").Select 
    With Selection 
     .HorizontalAlignment = xlGeneral 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Columns("AN:AN").Select 
    Selection.Cut 
    Columns("T:T").Select 
    ActiveSheet.Paste 
    Columns("U:U").Select 
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
    Range("A1").Select 
    With Selection.Font 
     .Name = "Arial" 
     .Size = 7 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontNone 
    End With 
    Range("A1").Select 
    With Selection.Font 
     .Name = "Arial" 
     .Size = 8 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontNone 
    End With 
    Range("A1").Select 
    With Selection.Font 
     .Name = "Arial" 
     .Size = 7.5 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontNone 
    End With 
    Range("A1").Select 
    With Selection.Font 
     .Name = "Arial" 
     .Size = 7 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontNone 
    End With 
    Range("A1").Select 
    Range("D1").Select 
    With Selection.Font 
     .Name = "Tahoma" 
     .Size = 8 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontNone 
    End With 
    Range("D1").Select 
    With Selection.Font 
     .Name = "Arial" 
     .Size = 8 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ThemeColor = xlThemeColorLight1 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontNone 
    End With 
    Columns("C:C").ColumnWidth = 47.14 
    Columns("F:F").ColumnWidth = 13.43 
    Columns("H:H").ColumnWidth = 18.57 
    Columns("I:I").EntireColumn.AutoFit 
    Columns("J:J").ColumnWidth = 14.14 
    Columns("K:K").ColumnWidth = 12.14 
    Columns("K:K").ColumnWidth = 11 
    Columns("M:M").ColumnWidth = 20.43 
    Columns("N:N").ColumnWidth = 12.29 
    Columns("N:N").ColumnWidth = 12.71 
    Columns("O:O").ColumnWidth = 12.43 
    Columns("R:R").ColumnWidth = 13.57 
    Columns("S:S").ColumnWidth = 24.57 
    Columns("T:T").ColumnWidth = 28.57 
    Columns("A:A").ColumnWidth = 35 
    Columns("U:AU").Select 
    Selection.Delete Shift:=xlToLeft 
'End of Joyce's Macro 
Columns("D:D").Select 
    Selection.Delete Shift:=xlToLeft 
    Rows("1:19").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
     "=SEARCH(""CTC"",$S2)" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 255 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$I2>=10000" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 65535 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$N2>=30" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent4 
     .TintAndShade = 0.399945066682943 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _ 
     Formula1:="=0" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 15773696 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
     "=AND(D2>=TODAY()-7,D2<=TODAY())" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 5287936 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _ 
     , Formula1:="=30" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent6 
     .TintAndShade = -0.249946592608417 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Range("A2").Select 
    Cells.FormatConditions.Delete 
    Range("A2:A5000").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
     "=SEARCH(""CTC"",$S2)" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 255 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Range("B2:B5000").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$I2>=10000" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 65535 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Range("C2:C5000").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$N2>=30" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent4 
     .TintAndShade = 0.399945066682943 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Range("I2:I5000").Select 
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _ 
     Formula1:="=0" 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(COUNTBLANK($I2)=0,$I2=0)" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 15773696 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Range("D2:D5000").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
     "=AND(D2<=TODAY()+7,D2>=TODAY())" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .Color = 5287936 
     .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
    Range("M2:M5000").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
     "=M2<=TODAY()-30" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Interior 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent6 
     .TintAndShade = -0.249946592608417 
    End With 
    Selection.FormatConditions(1).StopIfTrue = False 
Application.DisplayAlerts = True 
End Sub

來源

2017-03-15 dwirony

這是所有的選擇並激活由宏記錄放在那裏。您需要通過直接引用單元格來更改vba如何引用單元格，而不是使用「選擇」或「激活」。看到這裏：http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros –

謝謝斯科特 - 我會去看看那裏 – dwirony

好了，你關閉事件...此塊對我來說是相當標準的宏代碼做任何事情之前：

Dim PrevCalc As XlCalculation 
With Application 
    PrevCalc = .Calculation 
    .Calculation = xlCalculationManual 
    .Cursor = xlWait 
    .Calculate 
    .EnableEvents = False 
    .ScreenUpdating = False 
End With

然後我「撤消」當宏完成，或在情況錯誤：

With Application 
    .Cursor = xlDefault 
    .Calculate 
    .Calculation = PrevCalc 
    '.ScreenUpdating = True 'Not Needed... 
    .EnableEvents = True 
End With

順便說一句，你每次調用操作修改的細胞，在技術上是一個COM調用 - 所以你要儘量減少他們。宏記錄不夠聰明，無法知道何時修改一個單元，你只做一件事。

因此，例如，在這兒，你真的只是想中心的文字：

Range("A1").Select 
With Selection 
    .HorizontalAlignment = xlCenter 
    .VerticalAlignment = xlTop 
    .WrapText = True 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .ReadingOrder = xlContext 
    .MergeCells = False 
End With

將其更改爲：

Range("A1").HorizontalAlignment = xlCenter

來源

2017-03-15 18:23:38 flaZer

哇！添加這兩個第一位的代碼是我錯過了！我還清理了很多「選擇」行，現在它在<2秒內運行！完美，謝謝！ – dwirony

Plz告訴喬伊斯我說你好:) – flaZer

即使事件已關閉，Excel VBA代碼運行也非常緩慢

回答

相關問題