我的代码运行大约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
答案 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个,我清理了一下。我也对无用的选择做了评论。
下一个问题:它有什么作用?看起来像它
现在,您必须排除故障,以了解哪个嫌疑人有罪。为此,您可以在宏的几个战略线上添加断点,以查看需要时间的内容(我打算计算,但我可能错了)。尤其是之前和之后计算后& Workbook.add
但问问自己,我列出的所有内容都是有用的,尤其是计算部分,尤其是workbook.add部分。你的宏可能会充斥着计算机内存,所有那些在内存中打开的工作簿仍然无用。