非常慢的Excelmacros

我正试图通过倾倒一堆数据并重新格式化来自动处理每天必须做的工作。 我一直在这个工作了很长一段时间，最后一个地方，我想我会在一个论坛上寻求帮助。 我已经做了一些研究，并且包含了我在macros中可以find的许多build议。 当我第一次创buildmacros，我有所有的“select”在那里，它运行得很快。 当我一直运行它的试用目的，它变得越来越慢。 现在需要2分钟或更长时间才能完成，并在1秒钟内停止响应，然后在2-3分钟后完成。

这样做的目的是为了查看表单的信息，并根据date创build表单来优先化信息。 所有的date链接到一个表单调用“热表”，但我创build一个新表，然后切换公式引用，所以Excel不会自己工作。 我是一个新手，自学，所以请容易对我。

PS：当我保存文件时，它现在提示我说：“隐私警告：本文档包含macros，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 

Answer 1

尝试closures屏幕更新以释放系统资源。 您的macros可能还有其他问题，但是您应该注意到性能的显着提升。

在你的macros的开始添加：

 Application.ScreenUpdating = False 

在最后（在'End Sub'之前）添加：

 Application.ScreenUpdating = True 

我希望这有帮助。

Answer 2

从哪儿开始？ 顺便说一句，不要采取错误的方式，它清楚你已经知道如何让Excel做你想要的VBA这些技巧是关于解决你的问题在性能方面更多。

1. Application.ScreenUpdating = False（在开始时）结束时重新打开。
2. 您似乎有使用公式R1C1表示法的优先select，将其replace为通过.Range2属性将来自每个单元块的所有input数据转换为二维数组的模式。
3. 根据需要使用循环对数据进行所有转换以更新数组中的值。
4. 将数组写回到传递给.Range2属性的完全相同大小的单元格区域。
5. With块看起来很无害，你可以离开他们。
6. 将格式条件移到最后，除非您更早需要（不应该）。
7. 添加一个表（listobject），并将您的范围转换为。 然后使用数据块引用上面提示（2.）中要修改的数据。
8. 如果必须使用表格插入行。 不过你最好还是使用数组中的数据，根据需要在数组中添加行（元素），然后计算新的数组大小，并按照技巧（2.到4.）写回数组。