运行几分钟后，Excel宏崩溃

Question

我的代码运行大约5分钟，然后进入恢复错误/消息。我已经发布了3个Call宏，但代码中有40个。

在宏观期间，细胞需要计算，我尝试了一段时间来帮助但没有好处。

 Private Sub Worksheet_calculate()

    If Range("$be8").Value = 1 Then
    Application.EnableEvents = True
    Call Macro1
    Application.EnableEvents = False
    End If
    If Range("$bf8").Value = 1 Then
    Application.EnableEvents = True
    Call Macro2
    Application.EnableEvents = False
    End If
    If Range("$bg8").Value = 1 Then
    Application.EnableEvents = True
    Call Macro3
    Application.EnableEvents = False
    End If


 Sub Macro1()
'
'

     Macro1 Macro
    '

    '

            Sheets("Calc. 1").Select
            Rows("11:11").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Application.Wait (Now + TimeValue("0:00:05"))
            Rows("7:7").Select
            Selection.Copy
            Rows("11:11").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("B1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = ""
            Range("B2").Select
            Sheets("Calc.").Select
            Range("A7:Q50002").Select
            Selection.Copy
            Range("A3").Select
            ActiveSheet.Paste
            Calculate
            Range("AZ3").Select
            Selection.Copy
            Range("BA3").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("A1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = ""
            Range("B1").Select
            Workbooks.Add
            DoEvents
        End Sub


        Sub Macro2()
        '
        ' Macro2 Macro
        '

        '
            Sheets("Calc. 1").Select
            Rows("11:11").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Application.Wait (Now + TimeValue("0:00:05"))
            Rows("7:7").Select
            Selection.Copy
            Rows("11:11").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("B1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = ""
            Range("B2").Select
            Sheets("Calc.").Select
            Range("A8:Q50002").Select
            Selection.Copy
            Range("A3").Select
            ActiveSheet.Paste
            Calculate
            Range("AZ3").Select
            Selection.Copy
            Range("BA3").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("A1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = ""
            Range("B1").Select
            Workbooks.Add
            DoEvents
        End Sub

        Sub Macro3()
        '
        ' Macro3 Macro
        '

        '
            Sheets("Calc. 1").Select
            Rows("11:11").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Application.Wait (Now + TimeValue("0:00:05"))
            Rows("7:7").Select
            Selection.Copy
            Rows("11:11").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("B1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = ""
            Range("B2").Select
            Sheets("Calc.").Select
            Range("A9:Q50002").Select
            Selection.Copy
            Range("A3").Select
            ActiveSheet.Paste
            Calculate
            Range("AZ3").Select
            Selection.Copy
            Range("BA3").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("A1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = ""
            Range("B1").Select
            Workbooks.Add
            DoEvents
        End Sub

Answer 1

首先，这只是一大堆录制的宏，因此几乎不可读，正如Matt Webb在其出色的评论中暗示的那样。话虽这么说，我去做了一些分析。

除了范围（“A7：Q50002”）的列之外，宏是完全相同的。选择，从7到9不等（如果你真的有，可能最多46个其中40个）。是时候使用参数制作一个合适的子：

Private Sub Worksheet_calculate()
    If Range("$be8").Value = 1 Then
    Application.EnableEvents = True
    Call Macro(myRow)
    Application.EnableEvents = False
    End If
    If Range("$bf8").Value = 1 Then
    Application.EnableEvents = True
    Call Macro(myRow)
    Application.EnableEvents = False
    End If
    If Range("$bg8").Value = 1 Then
    Application.EnableEvents = True
    Call Macro(myRow)
    Application.EnableEvents = False
    End If
End Sub


 Sub Macro(myRow)
    Sheets("Calc. 1").Rows("11:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.Wait (Now + TimeValue("0:00:05"))
    Rows("7:7").Copy
    Rows("11:11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    'Range("B2").Select
    Sheets("Calc.").Range("A" & CStr(myRow) & ":Q50002").Copy
    Range("A3").Select
    ActiveSheet.Paste
    Calculate
    Range("AZ3").Copy
    Range("BA3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    'Range("B1").Select
    Workbooks.Add
    DoEvents
End Sub

它仍然很难看，但是现在，你只有一个主要程序而不是40个，我清理了一下。我也对无用的选择做了评论。

下一个问题：它有什么作用？看起来像它

• 插入行11，然后将行7复制到。那个不会有问题。
• 将特定单元格从其他工作表复制到当前工作表。好吧，为什么不呢。
• 计算。我们有一个问题。我不清楚你的计算，这里很可能是循环的东西，或者做大量的计算。特别是当我看到硬编码值进入第50000行时......狼可能会藏在这里。取决于您的工作表。这是我的第一个嫌疑人。
• 复制主工作表中的另一个单元格。这里没有风险。
• 添加空工作簿。什么都没有。嗯，你确定吗？如果您的40个值是正数，则动态打开40个工作簿，而不是命名它们，或者在其中放入任何数据？这是我的第二个也是最后一个嫌疑人。

现在，您必须排除故障，以了解哪个嫌疑人有罪。为此，您可以在宏的几个战略线上添加断点，以查看需要时间的内容（我打算计算，但我可能错了）。尤其是之前和之后计算后＆amp; Workbook.add

但问问自己，我列出的所有内容都是有用的，尤其是计算部分，尤其是workbook.add部分。你的宏可能会充斥着计算机内存，所有那些在内存中打开的工作簿仍然无用。