Excel宏在运行几分钟后崩溃

我的代码运行了大约5分钟，出现了恢复错误/消息。我发布了3个调用宏，但代码中有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

---

首先，正如马特·韦伯在其精彩评论中所暗示的那样，这只是一大包录制的宏，因此几乎无法阅读。话虽如此，我还是去做了一些分析

除了范围（“A7:Q50002”）的列之外，宏是完全相同的。选择，范围从7到9不等（如果您真的有40个宏，可能最多46个宏）。使用参数制作适当接头的时间：

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个工作簿，而不命名它们，也不在其中放入任何数据？？？这是我的第二个也是最后一个嫌疑犯

现在，你必须对自己进行故障排除，以确定哪个嫌疑人有罪。为此，您可以在宏的几个策略行上添加断点，以查看需要花费的时间（我在计算上的赌注，但我可能错了）。特别是在计算工作簿之前和之后。添加

---

但是问问自己，我列出的所有东西都有用吗，尤其是计算部分，尤其是工作簿。添加部分。你的宏很可能会让所有在内存中打开但仍然无用的工作簿充斥计算机内存。

你想用这些宏实现什么，如果你解释你试图解决的问题，将有一个简单的

VBA

解决方案。：-）在某些情况下，在

工作表\u calculate

中，您正在禁用事件，然后退出：在该点之后将不会触发该事件处理程序。不清楚这是否是您想要/打算的。我假设您正在运行一个流程密集型公式或一组单元格上的一组公式。请尝试在工作表_calculate（）过程的开头添加Application.screenUpdated=False，并在其结尾添加Application.screenUpdate=True，看看是否有帮助。您好。A3-Q50000是保存数据的单元格。在这个数据中，我在第q行右边的单元格中计算的信息块。所以可能有15行。公式计算这些行，并将结果插入到计算表中插入的行中。因为块的范围可以是4-50，这就是我有不同调用代码的地方。一系列单元格让它知道块有多大，例如BE7=4，所以如果块是4，BE8将是1。BD7=5，因此BD8将为1。然后，它将运行相应的宏来复制和粘贴A3、4、5、6、7、8、9、-Q50000以移动到下一个块。