Fatal编程技术网
  • excel/
  • Excel VBA代码运行极慢，即使事件已关闭

Excel VBA代码运行极慢，即使事件已关闭

excel vba

Excel VBA代码运行极慢，即使事件已关闭,excel,vba,Excel,Vba,下面是我的一些同事用来清理excel文档的宏。真是一团糟！信不信由你，这是经过清理的版本（我删除了大量的activewindow滚动，反复调整列宽和行宽）。即使在我所有的清理（和关闭事件）之后，这段代码仍然运行缓慢（10-15秒），并在整个页面上滚动。关于我如何改进它以使其运行得更快，有什么想法吗 Sub MyMacro() Application.DisplayAlerts = False Sheets("P H T Funnel Summary_1").Select Acti

下面是我的一些同事用来清理excel文档的宏。真是一团糟！信不信由你，这是经过清理的版本（我删除了大量的activewindow滚动，反复调整列宽和行宽）。即使在我所有的清理（和关闭事件）之后，这段代码仍然运行缓慢（10-15秒），并在整个页面上滚动。关于我如何改进它以使其运行得更快，有什么想法吗

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

Sub MyMacro（）
Application.DisplayAlerts=False
表格（“P H T漏斗汇总表1”）。选择
ActiveWindow.SelectedSheets.Delete
行（“1:21”）。选择
选择.ClearContents
选择。删除移位：=xlUp
“乔伊斯宏
行（“1:1”）。行高=51
行（“1:1”）。行高=44.25
范围（“A1”）。选择
有选择
.HorizontalAlignment=xlCenter
.垂直对齐=xlTop
.WrapText=True
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
列（“F:F”）。选择
选择，剪
列（“B:B”）。选择
活动表。粘贴
Selection.ColumnWidth=14.29
列（“B:B”）。选择
有选择
.HorizontalAlignment=xlGeneral
.WrapText=False
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
有选择
.HorizontalAlignment=xlCenter
.WrapText=False
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
列（“G:G”）。选择
选择，剪
列（“C:C”）。选择
活动表。粘贴
范围（“D1”）。选择
ActiveCell.FormulaR1C1=“报价账户名称”
范围（“D1”）。选择
有选择
.HorizontalAlignment=xlGeneral
.垂直对齐=xlTop
.WrapText=False
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
Selection.Font.Bold=True
范围（“D1:D534”）。选择
Selection.Borders（xlDiagonalDown）.LineStyle=xlNone
Selection.Borders（xlDiagonalUp）.LineStyle=xlNone
带Selection.Borders（左）
.LineStyle=xlContinuous
.ColorIndex=0
.TintAndShade=0
.Weight=xlThin
以
带Selection.Borders（顶部）
.LineStyle=xlContinuous
.ColorIndex=0
.TintAndShade=0
.Weight=xlThin
以
带Selection.Borders（底部）
.LineStyle=xlContinuous
.ColorIndex=0
.TintAndShade=0
.Weight=xlThin
以
带Selection.Borders（右）
.LineStyle=xlContinuous
.ColorIndex=0
.TintAndShade=0
.Weight=xlThin
以
带Selection.Borders（xlInsideVertical）
.LineStyle=xlContinuous
.ColorIndex=0
.TintAndShade=0
.Weight=xlThin
以
带Selection.Borders（XLInsidehHorizontal）
.LineStyle=xlContinuous
.ColorIndex=0
.TintAndShade=0
.Weight=xlThin
以
列（“AB:AB”）。选择
选择，剪
列（“E:E”）。选择
活动表。粘贴
列（“K:K”）。选择
选择，剪
列（“G:G”）。选择
活动表。粘贴
列（“G:G”）。选择
有选择
.HorizontalAlignment=xlGeneral
.WrapText=False
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
有选择
.HorizontalAlignment=xlCenter
.WrapText=False
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
范围（“H1”）。选择
列（“L:L”）。选择
选择，剪
列（“H:H”）。选择
活动表。粘贴
列（“H:H”）.entireclumn.AutoFit
列（“I:I”）。选择
选择，剪
列（“I:I”）。选择
Application.CutCopyMode=False
选择。删除移位：=xlToLeft
Selection.ColumnWidth=12.29
有选择
.WrapText=True
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
列（“AN:AN”）。选择
选择，剪
列（“J:J”）。选择
活动表。粘贴
Selection.ColumnWidth=16
有选择
.WrapText=True
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
列（“AI:AI”）。选择
选择，剪
列（“K:K”）。选择
活动表。粘贴
范围（“K1”）。选择
有选择
.HorizontalAlignment=xlCenter
.垂直对齐=xlTop
.WrapText=True
.方向=0
.AddIndent=False
.1级别=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
以
范围（“L1”）。选择
ActiveCell.FormulaR1C1=“”
列（“AJ:AJ”）。选择
选择，剪
列（“L:L”）。选择
活动表。粘贴
列（“M:M”）。选择
选择，剪
Application.CutCopyMode=False
选择。删除移位：=xlToLeft
范围（“N1”）。选择
选择.ClearContents
列（“X:X”）。选择
选择，剪
范围（“N1”）。选择
活动表。粘贴
量程（“O1”）.Sel

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



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