非常非常慢的Excel宏

我試圖通過傾倒一個數據池並重新格式化來每天在工作中必須做的自動化過程。我已經在這方面做了很長時間了，我認爲我最後會在一個論壇上尋求幫助。我已經完成了一些研究，並且包含了許多我可以在宏中找到的建議。當我第一次創建宏時，我已經擁有了所有的「選擇」，並且運行速度很快。由於我一直在試運行它，它變得越來越慢。現在需要2分鐘或更長時間才能完成，在1秒鐘內停止響應，然後在2-3分鐘後完成。非常非常慢的Excel宏

這樣做的目的是爲了查看錶格的信息並根據日期創建表格來優先化信息。所有日期都鏈接到表單調用「Hot Sheet」，但我創建了一個新表單，然後切換公式引用，以使Excel不會自行工作。我是一個新手，自學，所以請容易對我。

PS：當我保存文件時，它現在提示我說：「隱私警告：本文檔包含宏，ActiveX控件，XML擴展包信息或Web組件，可能包括個人信息，這些信息無法通過文件檢查員「。

代碼：

ActiveSheet.Name = "Sheet1" 
Columns("A:A").Select 
Range("A4").Activate 
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ 
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ 
    True 

Rows("1:3").Insert Shift:=xlDown 
Range("A1:T1").Select 
With Selection 
    .HorizontalAlignment = xlCenter 
    .VerticalAlignment = xlBottom 
    .WrapText = False 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .ReadingOrder = xlContext 
    .MergeCells = False 
End With 
Range("A1:T1").Merge 
Range("A1:T1").FormulaR1C1 = "ASCP Planner Overview Report" 
Range("A4").FormulaR1C1 = "Input Perameters" 
Rows("5:37").ClearContents 
Range("B4").ClearContents 
Range("B5").FormulaR1C1 = "Instance Name" 
Range("B6").FormulaR1C1 = "MRP Plan Name" 
Range("B7").FormulaR1C1 = "Organization Code" 
Range("B8").FormulaR1C1 = "Bucket Type" 
Range("B9").FormulaR1C1 = "Report Type" 
Range("B10").FormulaR1C1 = "Planner" 
Range("B11").FormulaR1C1 = "Planner user name" 
Range("B12").FormulaR1C1 = "Planner Lookup" 
Range("B13").FormulaR1C1 = "Supplier" 
Range("B14").FormulaR1C1 = "SC Total" 
Range("B15").FormulaR1C1 = "Make/Buy" 
Range("B16").FormulaR1C1 = "Net Shortage Only" 
Range("B17").FormulaR1C1 = "Shortage Cutoff Date" 
Range(Selection, Selection.End(xlToRight)).Select 
Range("A40:F40").Cut Destination:=Range("E13:J13") 
Rows("43:61").Delete Shift:=xlUp 

On Error Resume Next 
With Application 
.ScreenUpdating = False 
.EnableEvents = False 
PrevCalc = .Calculation 
.Calculation = xlCalculationManual 
End With 
Columns("A:A").ColumnWidth = 11 
Range("T41").FormulaR1C1 = "Page 1" 
Range("E50").FormulaR1C1 = "=R[-5]C[-2]" 
Range("E50").AutoFill Destination:=Range("E50:T50"), Type:=xlFillDefault 
Range("B43").CutCopyMode = False 
Range("F49").FormulaR1C1 = "=R[-6]C[-2]&R[-6]C[-1]&R[-6]C&R[-6]C[1]" 
Range("F49").Copy 
Range("F49").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("E50:T50").Copy 
Range("E50:T50").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Rows("43:48").ClearContents 
Range("A43").FormulaR1C1 = "ORG" 
Range("A44").FormulaR1C1 = "Planner" 
Range("A45").FormulaR1C1 = "Sourcing Rule" 
Range("A46").FormulaR1C1 = "OH Qty-Insp" 
Range("A47").FormulaR1C1 = "Negative" 
Range("A48").FormulaR1C1 = "OH-Consign" 
Range("B43").FormulaR1C1 = "Item Number" 
Range("B44").FormulaR1C1 = "Make/Buy" 
Range("B46").FormulaR1C1 = "OH Qty-Total" 
Range("B47").FormulaR1C1 = "In trans Qty" 
Range("B48").FormulaR1C1 = "LT (Post P)" 

     Range("93:93,95:112,155:155,157:174,217:217,219:236,279:279,281:298,341:341,343:360,403:403 ,405:422").Delete Shift:=xlUp 
Rows("351:351").Delete Shift:=xlUp 
Rows("352:369").Delete Shift:=xlUp 
Rows("394:394").Delete Shift:=xlUp 
Rows("395:412").Delete Shift:=xlUp 
Rows("437:437").Delete Shift:=xlUp 
Rows("440:455").Delete Shift:=xlUp 
Rows("439:439").Delete Shift:=xlUp 
Rows("481:481").Delete Shift:=xlUp 

Range("57:57,63:63,69:69,75:75,81:81,87:87").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("99:101").Insert Shift:=xlDown 
Range("F101").FormulaR1C1 = "=R[-52]C" 
Range("E102:T102").FormulaR1C1 = "=R[-52]C" 
Range("E102:T102").Select 
Range("109:109,115:115,121:121,127:127,133:133,139:139").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("151:153").Insert Shift:=xlDown 
Range("F153").FormulaR1C1 = "=R[-52]C" 
Range("E154:T154").FormulaR1C1 = "=R[-52]C" 
Range("E154:T154").Select 
Range("161:161,167:167,173:173,179:179,185:185,191:191").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("203:205").Insert Shift:=xlDown 
Range("F205").FormulaR1C1 = "=R[-52]C" 
Range("E206:T206").FormulaR1C1 = "=R[-52]C" 
Range("E206:T206").Select 
Range("213:213,219:219,225:225,231:231,237:237,243:243").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("255:257").Insert Shift:=xlDown 
Range("F257").FormulaR1C1 = "=R[-52]C" 
Range("E258:T258").FormulaR1C1 = "=R[-52]C" 
Range("E258:T258").Select 
Range("265:265,271:271,277:277,283:283,289:289,295:295").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("307:309").Insert Shift:=xlDown 
Range("F309").FormulaR1C1 = "=R[-52]C" 
Range("E310:T310").FormulaR1C1 = "=R[-52]C" 
Range("E310:T310").Select 
Range("317:317,323:323,329:329,335:335,341:341,347:347").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("359:361").Insert Shift:=xlDown 
Range("F361").FormulaR1C1 = "=R[-52]C" 
Range("E362:T362").FormulaR1C1 = "=R[-52]C" 
Range("E362:T362").Select 
Range("369:369,375:375,381:381,387:387,393:393,399:399").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("411:413").Insert Shift:=xlDown 
Range("F413").FormulaR1C1 = "=R[-52]C" 
Range("E414:T414").FormulaR1C1 = "=R[-52]C" 
Range("421:421,427:427,433:433,439:439,445:445,451:451").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("463:465").Insert Shift:=xlDown 
Range("F465").FormulaR1C1 = "=R[-52]C" 
Range("E466:T466").FormulaR1C1 = "=R[-52]C" 
Range("473:473,479:479,485:485,491:491,497:497,503:503").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Rows("515:517").Insert Shift:=xlDown 
Range("F517").FormulaR1C1 = "=R[-52]C" 
Range("E518:T518").FormulaR1C1 = "=R[-52]C" 
Rows("519:519").Delete Shift:=xlUp 
Range("525:525,531:531,537:537,543:543,549:549,555:555").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
With Application 
.ScreenUpdating = True 
.EnableEvents = True 
.Calculation = PrevCalc 
End With 

On Error Resume Next 

Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 
Cells.Select 
Range("C562").Activate 
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ 
    Formula1:="=0" 
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
With Selection.FormatConditions(1).Font 
    .Color = -16383844 
    .TintAndShade = 0 
End With 
With Selection.FormatConditions(1).Interior 
    .PatternColorIndex = xlAutomatic 
    .Color = 13551615 
    .TintAndShade = 0 
End With 
Selection.FormatConditions(1).StopIfTrue = False 
Range("A50").Select 
    Union(Range(_ 
    "B291,B298,B305,B315,B322,B329,B336,B343,B350,B357,B367,B374,B381,B388,B395,B402,B409,B419,B426,B55,B62,B69,B76,B83,B90,B97,B107,B114,B121,B128,B135,B142" _ 
    ), Range(_ 
    "B149,B159,B166,B173,B180,B187,B194,B201,B211,B218,B225,B232,B239,B246,B253,B263,B270,B277,B284" _ 
    )).Select 
Range("B426").Activate 
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ 
    Formula1:="=0" 
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
With Selection.FormatConditions(1).Font 
    .Color = -16752384 
    .TintAndShade = 0 
End With 
With Selection.FormatConditions(1).Interior 
    .PatternColorIndex = xlAutomatic 
    .Color = 13561798 
    .TintAndShade = 0 
End With 
Selection.FormatConditions(1).StopIfTrue = False 
Range("A401").Select 
Range("A51").Select 

Application.DisplayAlerts = False 
On Error Resume Next 
Sheets("Sheet1").Copy Before:=Sheets(1) 
ActiveSheet.Select 
Sheets("View1").Delete 
ActiveSheet.Name = "View1" 
Sheets("Hot Sheet").Select 
Cells.Select 
ActiveSheet.Range("$A$1:$D$524").AutoFilter Field:=4 
ActiveSheet.Range("$A$1:$D$524").AutoFilter Field:=1 
Selection.Replace What:="View2", Replacement:="View1", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
Sheets("View1").Copy Before:=Sheets(1) 
Sheets("View1 (2)").Select 
Sheets("View2").Delete 
Sheets("View1 (2)").Name = "View2" 
Sheets("Hot Sheet").Select 
Cells.Select 
Selection.Replace What:="View1", Replacement:="View2", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
ActiveSheet.Range("$A$1:$D$524").AutoFilter Field:=1, Criteria1:=Array(_ 
"NA:ASH", "NA:DLM", "NA:FOR", "NA:FRK", "NA:LRS", "NA:MON", "NA:NWK", "NA:YRB", _ 
"NA:YRK"), Operator:=xlFilterValues 
Range("A1").Select 
Sheets("Sheet1").Delete 
Application.EnableEvents = True 
End Sub

來源

2014-09-03 Nicolas Martin

提示，不要使用複製和粘貼，而是使用'Sheets（「View2」）在數組範圍內賦值。Range（「A1：D500」）。Value = Sheets（「View1」）。Range 「A1：D500」）。值。例如。 – ja72 2014-09-03 23:15:31

並且不要使用Insert（）來移動單元格，只要將單元格放在正確的行中就可以開始。 – ja72 2014-09-03 23:16:17

它是.Range2不是範圍如果你想優化傳遞數組 – 2014-09-03 23:28:54

嘗試關閉屏幕更新，以釋放系統資源。您的宏可能還有其他問題，但您應該注意到性能的顯着提升。

在宏附加的開頭：

Application.ScreenUpdating = False

末（「結束子「前右）地址：

Application.ScreenUpdating = True

我希望這有助於

來源

2014-09-03 23:22:12

是的，我試過這個。我沒有真正注意到一個改進。我只是感到失望，因爲更多的技巧是跟着讓這件事情變得越來越快，似乎變得越來越慢。我想也許這是一個公司電腦的事實。但正如我在原帖中所說的那樣。當它選擇的賣出，你不得不看它跳，但它沒有凍結，並通過更快的速度。 – 2014-09-04 01:52:30

在哪裏。開始？順便說一句，不要採取錯誤的方式，它清楚你已經知道如何讓Excel使用VBA來做你想做的事情，這些提示更多的是關於在性能方面解決你的問題。

Application.ScreenUpdating = False（開始時）結束時再次打開。
您似乎偏好使用帶公式的R1C1表示法，並使用通過.Range2屬性將來自每個單元塊的所有輸入數據的模式替換爲2維數組。
根據需要使用循環更新數組中的值，執行數據的所有轉換。
將數組寫回到傳遞給.Range2屬性的完全相同大小的單元格區域。
With塊看起來非常無害，你可以離開它們。
將格式條件移至最後，除非您之前需要（不應該）。
添加一個表（listobject）並將您的範圍轉換爲該範圍。然後使用數據塊引用上面提示（2.）中要修改的數據。
如果必須使用該表插入行。然而，你會更好，使用數組中的數據，根據需要在數組中添加行（元素），然後計算新的數組大小並按照技巧（2.到4.）寫回數組。

來源

2014-09-04 04:06:57

我不確定這是否有助於提供更多信息，但我添加了一些內容，可以創建新的工作簿並在新工作簿中重新創建所有內容。它在大約5秒鐘內完成。這是否意味着一旦我保存工作簿，它只會慢得多？ – 2014-09-04 22:58:35

非常非常慢的Excel宏

回答

相關問題