代碼執行已中斷

Question

在Excel VBA中，我遇到了“錯誤”，該錯誤使宏停止，並且顯示一條消息“代碼執行已被中斷”。 我用引號引起了錯誤，因為當我選擇調試並檢查了提示錯誤的代碼行時，我發現它在邏輯上是合理的。

我最初在On Error GoTo 0遇到On Error GoTo 0 。 當我注釋掉有關該錯誤的代碼塊時，我得到了一個產生相同錯誤的新行。 而且，再次，當我在調試模式下檢查它時，新的“錯誤”在邏輯上是合理的。 這是確切的行：

If rRange.Row <> 3 And rRange.Row <> 17 Then

僅供參考，在這種情況下rRange.Row = 3，因此它不會產生錯誤。

為什么會發生這種情況，我該如何解決？

UPDATE代碼現在在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

Answer 1

哦，那回想起了我。 我想我曾經在10年前的Excel 2003上收到過此錯誤？ 也許？。 Excel會使自己陷入某種狀態。 代碼沒什么錯，只是它將不斷返回該錯誤。

如果保存工作，請關閉Excel，然后重新打開，該錯誤是否消失了？ 如果我沒記錯的話，那是我調用某些外部API時引起的。 可能是您中的其他一些API調用導致了此錯誤，但此刻才顯現出來……也許。

抱歉，但是十年前:)

Answer 2

即使您經歷了它，也可能要考慮發布的代碼的以下“重新樣式化”

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函數來處理策略選擇

  這個功能：

  • 同時也檢查正確的選擇行和工作表（因為用戶有可能在選擇過程中轉移到另一個工作表！）

  • 運行循環，直到用戶選擇適當的單元格

  • 用戶取消InputBox時退出選擇，這是唯一的循環轉義可能性

• 在這里和那里做了一些簡化，例如：

  • 除非確實需要，否則消除了Activate語句

  • 將變量的數量減少到（幾乎）嚴格需要的變量

  • 添加了一些With ... End With塊以增加可讀性

  • 使用Select Case塊而不是If ... Then ... Else if ... Else ... End if一個，則再次可讀

  • 將.Value更改為.Formula ，以獲取正確的語法

以上所有內容都可以幫助您完成本項目，並在以后的項目中也有幫助