代码执行已被中断
在Excel VBA中，我遇到了一个“错误”，使macros停止，并显示一条消息“代码执行已被中断”。 我用引号写错了，因为当我selectdebugging并检查提示错误的代码行时，我发现它在逻辑上是合理的。
我最初遇到On Error GoTo 0 。 当我在这个错误周围注释掉一个块时，我会得到一个产生相同错误的新行。 再次，当我在debugging模式下检查它时，新的“错误”在逻辑上是合理的。 这是确切的一行：
If rRange.Row <> 3 And rRange.Row <> 17 Then
FYI，rRange.Row = 3在这种情况下，所以它不应该产生一个错误。
为什么会发生这种情况，我该如何解决？
更新代码现在会在End Sub行上产生错误。
这是失败的部分：
Sub Review() Dim WorkRange As Range Dim FoundCells As Range Dim Cell As Range Dim a As String Dim policy As String Dim rRange As Range Set RR = Sheets("Ready for Review") Set OG = ActiveSheet OG.Unprotect ("Password") RR.Activate On Error Resume Next Application.DisplayAlerts = False Set rRange = Application.InputBox(Prompt:= _ "Please select POLICY to review.", _ Title:="SPECIFY POLICY", Type:=8) On Error GoTo 0 Application.DisplayAlerts = True If rRange.Row <> 3 And rRange.Row <> 17 Then MsgBox "Value other than a POLICY was selected. Select the cell that contains the correct policy number." Exit Sub Else policy = rRange.Value End If Application.ScreenUpdating = False OG.Cells(12, 2).Locked = False Set WorkRange = OG.UsedRange For Each Cell In WorkRange If Cell.Locked = False Then col1 = Cell.Column Row = Cell.Row a = OG.Cells(Row, 1) If Not a = "" Then row2 = Application.WorksheetFunction.Match(a, RR.Range("A:A"), 0) Cell.Value = RR.Cells(row2, rRange.Column + col1 - 2) End If End If Next Cell OG.Unprotect ("Password") OG.Cells(33, 3).Locked = False If (Right(OG.Cells(5, 2), 2) = "UL" Or Right(OG.Cells(5, 2), 2) = "IL" Or Right(OG.Cells(5, 2), 2) = "PL") Then With OG.Cells(33, 3) .Value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""Total*"",A:A,0)))-SUM(C34:C37)" .Locked = True End With ElseIf Right(OG.Cells(5, 2), 2) = "WL" Then With OG.Cells(33, 3) .Value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0))) - IFERROR(INDEX(C34:C37,MATCH(""Additional"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Paid"",B34:B37,0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Additional Agreement - SPPUA"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Flexible Agreement - FLXT10/20"",B34:B37, 0)),0)" .Locked = True End With Else With OG.Cells(33, 3) .Value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0)))" .Locked = True End With End If OG.Activate Cells(Application.WorksheetFunction.Match("Last Month Paid ($)", Range("A:A"), 0), 2).NumberFormat = "$#,##0.00;[Red]$#,##0.00" OG.Protect ("Password") Application.ScreenUpdating = True End Sub
哦，这给我带回了回忆。 我想我以前得到这个错误大约10年前的Excel 2003？ 也许？。 Excel会让自己陷入一种状态。 代码没有什么错，只是它会不断回来，这个错误。
如果你保存你的工作closuresExcel然后重新打开，错误消失了吗？ 如果我没有记错，那是因为我调用了一些外部的API。 也许在你的一些其他的API调用导致这个错误，但在这一点上显示…也许。
对不起，但它是10年以前:)
即使你通过它，你可能会考虑以下的“重新设置”您所发布的代码
Option Explicit Sub Review() Dim Cell As Range, rRange As Range Dim a As String Dim RR As Worksheet, OG As Worksheet Set RR = Sheets("Ready for Review") Set OG = ActiveSheet OG.Unprotect ("Password") Set rRange = GetUserInpt(RR) If rRange Is Nothing Then MsgBox "You aborted the POLICY selection" _ & vbCrLf & vbCrLf _ & "the procedure ends" _ , vbInformation Exit Sub End If Application.ScreenUpdating = False OG.Cells(12, 2).Locked = False For Each Cell In OG.UsedRange With Cell If Not .Locked Then a = OG.Cells(.row, 1) If Not a = "" Then .value = RR.Cells(CLng(Application.WorksheetFunction.Match(a, RR.Range("A:A"), 0)), _ rRange.Column + .Column - 2) End If End With Next Cell With OG.Cells(33, 3) .Locked = False Select Case Right(OG.Cells(5, 2), 2) Case "UL", "IL", "PL" .Formula = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""Total*"",A:A,0)))-SUM(C34:C37)" Case "WL" .Formula = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0))) - IFERROR(INDEX(C34:C37,MATCH(""Additional"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Paid"",B34:B37,0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Additional Agreement - SPPUA"",B34:B37, 0)),0) - IFERROR(INDEX(C34:C37,MATCH(""Flexible Agreement - FLXT10/20"",B34:B37, 0)),0)" Case Else .value = "=IF(INDEX(B:B,MATCH(""Total*"",A:A,0))="""",0,INDEX(B:B,MATCH(""*"",A:A,0)))" End Select .Locked = True End With OG.Activate Cells(Application.WorksheetFunction.Match("Last Month Paid ($)", Range("A:A"), 0), 2).NumberFormat = "$#,##0.00;[Red]$#,##0.00" OG.Protect ("Password") Application.ScreenUpdating = True End Sub Function GetUserInpt(sht As Worksheet) As Range Dim rRange As Range Application.DisplayAlerts = False sht.Activate On Error GoTo InputBoxCanceled Do While rRange Is Nothing Set rRange = Application.InputBox(Prompt:="Please select POLICY to review.", _ Title:="SPECIFY POLICY", _ Default:=sht.Cells(3, 1).Address, _ Type:=8) If rRange.Parent.Name <> sht.Name Then MsgBox "You must select a cell in '" & sht.Name & "' sheet" sht.Activate Set rRange = Nothing Else If rRange.row <> 3 And rRange.row <> 17 Then MsgBox "Value other than a POLICY was selected" _ & vbCrLf & vbCrLf _ & "Select the cell that contains the correct policy number" _ , vbCritical Set rRange = Nothing End If End If Loop Set GetUserInpt = rRange InputBoxCanceled: On Error GoTo 0 Application.DisplayAlerts = True End Function
主要修订适用于：
-
添加了一个
GetUserInpt函数来处理策略select这个function：
-
同时检查正确的select行和工作表（因为在select期间用户可能转移到另一个工作表）！
-
运行一个循环，直到用户select一个合适的单元
-
在用户取消
InputBox时退出select，作为唯一的循环转义可能性
-
-
在这里和那里做了一些简化，如：
-
消除
Activate陈述，除非真的需要 -
将variables的数量减less到仅仅（几乎）严格需要的数量
-
添加一些
With ... End与块添加可读性 -
使用
Select Case块而不是If ... Then ... Else if ... Else ... End if一个，则为了可读性 -
改为
.Formula，以获得正确的语法
-
以上所有的东西都可以帮助你在这个项目上，也可以在未来的项目中