即使closures事件,Excel VBA代码运行也非常缓慢

以下是我的一些同事已经用来清理excel文件的一个macros。 这是一个完整的混乱! 相信与否,这是我清理的版本(我删除了大量的活动窗口滚动,一遍又一遍地调整列宽和行宽)。 即使在我清理完毕(并closures事件)之后,此代码仍然运行缓慢(10-15秒),并在整个页面上滚动。 任何想法,我怎么修改这个运行它快一点?

Sub MyMacro() Application.DisplayAlerts = False Sheets("PHT 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 

那么,你closures了事件…这个块对我来说是相当标准的macros代码之前做任何事情:

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

然后我在macros完成的时候“撤销”,或者在错误的情况下:

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

顺便说一下,您调用的每个操作都会修改单元格,在技术上来说是一个COM调用 – 所以您需要将它们最小化。 macroslogging不够聪明知道什么时候修改一个单元,你只做一件事情。

所以例如在这里,你真的只想要中心的文字:

 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