Excel VBA-Code extrem langsam selbst läuft mit Ereignissen ausgeschaltet

Das folgende ist ein Makro, das einige meiner Kollegen hatte bereits ein Excel-Dokument zu bereinigen, wurde mit. Es war ein komplettes Chaos! Ob Sie es glauben oder nicht, dies ist die aufgeräumte Version (ich habe eine Tonne ActiveWindow Scrolling entfernt und die Spalten- und Zeilenbreiten immer wieder angepasst). Selbst nach all meiner Bereinigung (und dem Ausschalten von Ereignissen) läuft dieser Code immer noch langsam (10-15 Sekunden) und scrollt über die ganze Seite. Irgendwelche Ideen, wie ich das umgestalte, um es etwas schneller zu machen?Excel VBA-Code extrem langsam selbst läuft mit Ereignissen ausgeschaltet

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

Quelle

2017-03-15 dwirony

Es ist alle wählen und aktivieren, die dort durch den Makro-Rekorder gestellt werden . Sie müssen ändern, wie vba sich auf die Zellen bezieht, indem Sie direkt auf die Zellen verweisen und nicht Auswählen oder Aktivieren verwenden. Siehe hier: http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros –

Dank Scott - ich nehme einen Blick dort – dwirony

Nun, drehte man Ereignisse ... Dieser Block für mich weg ist ziemlich Standard, bevor Makrocode etwas tut:

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

Dann habe ich „rückgängig machen“, wenn das Makro beendet ist, oder für den Fall, Fehler:

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

By the way, modifiziert Zellen jede Operation Sie das nennen, ist technisch gesehen ein COM-Aufruf - so dass Sie sie minimieren möchten. Der Makro-Datensatz ist nicht intelligent genug, um beim Ändern einer Zelle zu wissen, dass Sie nur eine Sache machen.

So zum Beispiel hier, wo man wirklich nur den Text zentrieren möchten:

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

Ändern Sie es an:

Range("A1").HorizontalAlignment = xlCenter

Quelle

2017-03-15 18:23:38 flaZer

Whoa! Das Hinzufügen dieser 2 ersten Code-Bits ist das, was ich vermisste! Ich habe auch eine Menge der "ausgewählten" Zeilen aufgeräumt und jetzt läuft es in <2 Sekunden! Perfekt, danke! – dwirony

Plz erzählen Joyce Ich sagte hallo :) – flaZer

Excel VBA-Code extrem langsam selbst läuft mit Ereignissen ausgeschaltet

Antwort

Verwandte Themen