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 –

ありがとうScott - 私はそこに見てよ – 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呼び出しです - ので、あなたはそれらを最小限にすることをお勧めします。マクロレコードは、あなたが1つのことをしているだけのセルを変更するときを知るのに十分スマートではありません。例えばので

ここにあなたが本当に唯一のテキストを中央揃えにしたい：へ

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つの最初のコードを追加すると、私は行方不明になりました！私はまた、多くの "選択"行をクリーンアップし、今は<2秒で実行されています！完璧、ありがとう！ – dwirony

私はこんにちは:) – flaZer

Excel VBAコードが非常に遅くなっていても、イベントがオフになっても

答えて

関連する問題