非常非常慢的 Excel 宏

Posted 2023-02-24

技术标签:

【中文标题】非常非常慢的 Excel 宏【英文标题】：Very very slow Excel Macro 【发布时间】：2014-09-03 22:39:30 【问题描述】：

我正在尝试通过转储数据池并重新格式化它来自动化我每天在工作中必须执行的流程。我已经为此工作了很长一段时间，我认为我会去的最后一个地方是在论坛上寻求帮助。我已经进行了一些研究，并在我的宏中包含了尽可能多的建议。当我第一次创建宏时，我有所有的“选择”，它运行得很快。当我出于试用目的而继续运行它时，它变得越来越慢。现在需要 2 分钟或更长时间才能完成，并且在第一个 5 秒内停止响应，然后在 2-3 分钟后完成。

这样做的目的是重新格式化正在查看的工作表的信息，并根据日期创建工作表来确定信息的优先级。所有日期都链接到名为“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

【问题讨论】：

提示，不要使用复制和粘贴，而是在数组范围内赋值，例如Sheets("View2").Range("A1:D500").Value = Sheets("View1").Range("A1:D500").Value。并且不要使用Insert()移动单元格，只需将单元格放在正确的行中即可。如果你想优化传入数组，它是 .Range2 而不是 Range 这些数据是从哪里来的？数据库？我建议您编写一个有效的查询，以您想要的格式从数据库中获取数据。很难从那段巨大的代码中看出你在做什么。如果您遇到性能问题，您需要监控您的代码并尝试分析问题所在并专注于该问题。事实上，Excel 具有可扩展性限制，将您的业务流程基于 Excel 宏是一种责任我很抱歉为什么我写了这么多来回答问题。它是来自文本文件的数据转储。所以。 Ja72 我会尝试数组，但我插入帮助格式化。我正在将 PDF 文件转换为文本文件，然后尝试在 Excel 中复制 PDF 文件的格式以进行分析。所以 EletricLlama 没有查询。我只是想整理一些杂乱无章的废话。 【参考方案1】：

尝试关闭屏幕更新以释放系统资源。您的宏可能还有其他问题，但您应该注意到性能有了显着提高。

在宏的开头添加：

Application.ScreenUpdating = False

在最后（就在“End Sub”之前）添加：

Application.ScreenUpdating = True

我希望这会有所帮助。

【讨论】：

是的，我试过这个。我并没有真正注意到改进。我只是感到失望，因为越来越多的提示是为了让这件事变得更快，它似乎变得越慢。我想也许是因为它是一台公司的计算机。但正如我在原帖中所说。当它在选择sell时，你确实必须看着它跳来跳去，但它并没有冻结，它通过得更快。【参考方案2】：

从哪里开始？顺便说一句，不要误会，很明显您已经知道如何让 Excel 使用 VBA 完成您想要的操作，这些技巧更多地是关于在性能方面解决您的问题。

Application.ScreenUpdating = False（开始时）在结束时重新打开。您似乎更喜欢将 R1C1 表示法与公式一起使用，将其替换为通过 .Range2 属性将每个单元块中的所有输入数据获取到二维数组的模式。使用循环执行所有数据转换，以根据需要更新数组中的值。将数组写回到与数组中传递给 .Range2 属性的大小完全相同的单元格区域。 With 方块看起来很无害，您可以离开它们。除非您更早需要它（您不应该），否则将格式条件移到末尾。添加一个表（listobject）并将您的范围转换为该表。然后使用数据块引用您将在上面的提示 (2.) 中修改的数据。如果需要，请使用表格插入行。但是，您最好使用数组中的数据，根据需要在数组中添加行（元素），然后计算新的数组大小并按照提示（2. 到 4.）写回。李>

【讨论】：

我不确定这是否有助于为您提供更多信息，但我添加了一些内容来创建新工作簿并重新创建新工作簿中的所有内容。它在大约 5 秒内完成。这是否意味着一旦我保存工作簿，它就会变得慢很多？

以上是关于非常非常慢的 Excel 宏的主要内容，如果未能解决你的问题，请参考以下文章

打开excel总是提示宏禁用的解决方法

Excel里的宏有啥作用？

excel宏vba vlookup

将 pandas 数据框写入 xlsm 文件（启用宏的 Excel）

在 Excel 中重复宏，直到到达空白单元格

EXCEL VBA 自动发送邮件功能异常