Выполнение кода было прервано

Question

В Excel VBA я столкнулся с «ошибкой», которая останавливает макрос, и появляется сообщение «Выполнение кода было прервано». Я написал ошибку в цитатах, потому что, когда я выбрал отладку и просмотрел строку кода, вызвавшую ошибку, я увидел, что она была логически обоснованной.

Первоначально я столкнулся с ошибкой в ​​On Error GoTo 0. Когда я комментирую блок вокруг ошибки, я получаю новую строку, которая производит ту же ошибку. И снова, когда я рассматриваю его в режиме отладки, новая «ошибка» логически звучит. Вот точная линия:

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 

Answer 1

Ой, что навевает воспоминания для меня. Я думаю, что я использовал эту ошибку около 10 лет назад Excel 2003? Может быть?. Excel мог бы стать частью состояния. С кодом ничего не получилось, просто он будет продолжать возвращаться с этой ошибкой.

Если вы сохраните свою работу закройте Excel и затем снова откроете, ошибка исчезнет? Если я правильно помню, это было вызвано, когда я назвал внешний API. Возможно, какой-то другой вызов API в вашем случае вызывает эту ошибку, но проявляется на этом этапе ... возможно.

Извините, но это было более 10 лет назад :)

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 С блоками, чтобы добавить читаемость

  • использовал Select Case блок вместо с If ... Then ... Else if ... Else ... End if одной, для удобства чтения

  • изменил .Value к .Formula, для правильного синтаксиса

все, что выше, может помочь вам с этим проектом и в будущем из них тоже