运行几分钟后,Excel宏崩溃

时间:2016-01-12 10:05:36

标签: excel vba

我的代码运行大约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

1 个答案:

答案 0 :(得分:0)

首先,这只是一大堆录制的宏,因此几乎不可读,正如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个工作簿,而不是命名它们,或者在其中放入任何数据?这是我的第二个也是最后一个嫌疑人。

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

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