«При ошибке возобновить следующее» не работает

Question

У меня есть одна процедура в Excel VBA кода. В этом я использую синтаксис «ON ERROR ....».

Процедура начинается с ON ERROR RESUME NEXT чтобы пропустить все ошибки.
Но в какой-то момент я хочу изменить это состояние с ON ERROR RESUME NEXT на ON ERROR GOTO NX {NX - метка, определенная в той же процедуре.} И снова измените его на ON ERROR RESUME NEXT

Первый раз он работает отлично, но когда код переходит к следующему значению, он останавливается при любой ошибке и показывает предупреждающее сообщение. {как при ошибке goto 0 ведет себя}

Предоставление исходного кода, а также образцов данных рабочего листа, чтобы четко понять проблему, на которую нужно ответить.

Private Sub CommandButton1_Click()'This procedure create diff. sheets of 0th group in costsheet templates
'in every 0th group sheets pint all group in order to printsrlno wise
'get the total of ledgers in next column
'get the total of group in next to next column


Dim StruArr() As Variant   'Create and store once all data of GroupStruc
Dim DataArr() As Variant   'Get all the Data and seek in this of whose Belongs to in ID for Columnar Display of Heads


Dim R As Long
Dim C As Long
Dim R1 As Long
Dim XtraSp
Dim GrpRows As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next

Sheets("GroupStruc").Visible = True
Sheets("GroupStruc").Select

GrpRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
StruArr = Range("A2:D" & GrpRows)
DataArr = Range("A2:D" & GrpRows)


For R = 1 To UBound(StruArr, 1) ' First StruArray dimension is rows.
    If StruArr(R, 3) = "0" Then
       Sheets(StruArr(R, 2)).Delete
       Worksheets.Add.Name = StruArr(R, 2)
       XtraSp = ""
       ID = R + 1
       Sheets(StruArr(R, 2)).Select
       C = 1
       For R1 = R To UBound(DataArr, 1)
           If DataArr(R1, 3) <> 0 Then
              Grp = 1
              Do Until DataArr(Grp, 1) = DataArr(R1, 3)
                 Grp = Grp + 1
                 If Grp >= GrpRows Then Exit Do
              Loop
              XtraSp = DataArr(Grp, 2)
              Grp = 1
              Do Until Trim(Sheets(StruArr(R, 2)).Cells(Grp, 1)) = XtraSp
                 Grp = Grp + 1
                 If Grp >= GrpRows Then Exit Do
              Loop
              XtraSp = Sheets(StruArr(R, 2)).Cells(Grp, 1)
              XtraSp = Len(XtraSp) - Len(Trim(XtraSp))
              XtraSp = Space(XtraSp + 3)
           End If
           Sheets(StruArr(R, 2)).Cells(C, 1) = XtraSp & DataArr(R1, 2)
           XtraSp = ""
           With Sheets("GroupStruc").Range("C" & R1 + 1 & ":C1000")
                   Grp = .Find(What:=DataArr(R1, 1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
           End With
           If WorksheetFunction.SumIf(Sheets("ExpLedgers").Range("$H:$H"), DataArr(R1, 1), Sheets("ExpLedgers").Range("$F:$F")) = 0 And Grp <> "" Then
          Sheets(StruArr(R, 2)).Cells(C, 3) = "G"
          Sheets(StruArr(R, 2)).Cells(C, 4) = Len(Sheets(StruArr(R, 2)).Cells(C, 1)) - Len(Trim(Sheets(StruArr(R, 2)).Cells(C, 1)))
       Else
          Grp1 = WorksheetFunction.SumIfs(Sheets("ExpLedgers").Range("$F:$F"), Sheets("ExpLedgers").Range("$H:$H"), DataArr(R1, 1), Sheets("ExpLedgers").Range("$A:$A"), Sheets("MainMenu").Range("F3"))
          Sheets(StruArr(R, 2)).Cells(C, 2) = IIf(Grp1 <> 0, Grp1, "")
          Grp1 = WorksheetFunction.SumIfs(Sheets("ExpLedgers").Range("$J:$J"), Sheets("ExpLedgers").Range("$H:$H"), DataArr(R1, 1), Sheets("ExpLedgers").Range("$A:$A"), Sheets("MainMenu").Range("F3"))
          Sheets(StruArr(R, 2)).Cells(C, 4) = IIf(Grp1 <> 0, Grp1, "")
       End If
       C = C + 1
       If DataArr(R1 + 1, 3) = 0 Then Exit For
   Next
If StruArr(R + 1, 3) = "" Then Exit For
If C = 2 Then
   Sheets(StruArr(R, 2)).Delete
Else
    For C = 1 To ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
        If Sheets(StruArr(R, 2)).Cells(C, 4) = 0 And Sheets(StruArr(R, 2)).Cells(C, 3) = "G" Then
           Sheets(StruArr(R, 2)).Cells(C, 3) = "=SUBTOTAL(9,B1:B" & ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row & ")"
        ElseIf Sheets(StruArr(R, 2)).Cells(C, 3) = "G" Then
           For Grp = C + 1 To ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
               If Sheets(StruArr(R, 2)).Cells(Grp, 4) = Sheets(StruArr(R, 2)).Cells(C, 4) Then
                  Exit For
               End If
           Next
           Sheets(StruArr(R, 2)).Cells(C, 4) = ""
           Sheets(StruArr(R, 2)).Cells(C, 3) = "=SUBTOTAL(9,B" & C & ":B" & Grp - 1 & ")"
        End If
    Next
End If
End If

On Error GoTo Nx
'COMMENT BLOCK FROM THIS


If StruArr(R, 2) <> "" Then
   Sheets(StruArr(R, 2)).Select
   Rows("1:1").Select
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Range("B1:D1").Select
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlBottom
       .WrapText = False
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Selection.Merge
 End If
   Sheets(StruArr(R, 2)).Columns.AutoFit
   'COMMENT BLOCK UPTO THIS WILL THEN THIS PROCESS COMPLETE WITHOUT ANY ERROR


Nx:
On Error GoTo 0
On Error Resume Next
Next R
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

и данные как следующие

GROUPCODE,GROUPNAME,BELONGSTO,PRINTSRLNO

1,SOURCES OF FUNDS,0,1

2,APPLICATION OF FUNDS,0,2

3,INCOME,0,3

4,EXPENDITURE,0,4

9,INDIRECT COST HEAD,4,5

27,Insurance,9,6

13,MISCELLANEOUS COST,9,7

12,INTEREST & FINANCIAL CHARGES,9,8

11,STAFF SALARY & WAGES,9,9

10,OVERHEADS,9,10

8,DIRECT COST HEAD,4,11

29,Direct Overhead Cost,8,12

5,EXECUTION COST,8,13

28,Sub Contracting,5,14

26,LAND RENT,5,15

25,LOADING / UNLOADING CHARGES,5,16

24,ROYALTY,5,17

23,TRANSPORT CHARGES,5,18

22,SECURITY CHARGES,5,19

21,TESTING CHARGES,5,20

20,SURVEY CHARGES,5,21

19,PROCESSING FEES,5,22

18,PROFESSION CHARGES,5,23

17,CONSULTANCY CHARGES,5,24

6,MATERIAL COST,8,25

7,EQUIPMENT COST,8,26

16,HIRE CHARGES,7,27

15,Repairs and Maintenance Cost,7,28

14,Running Cost,7,29

http://www.4shared.com/photo/li3WNiVVce/un_online.html

Answer 1

Вы должны выйти из блока обработки ошибок с помощью оператора Resume . Ваш код может выглядеть примерно так.

Sub Example()

    On Error Goto nx

    for i = 1 to 10
        'code that may cause an error here
label1:
    Next i

    Exit Sub

nx:
    Resume label1
End Sub