'On Error Resume Next' не працює


0

У мене є одна процедура в 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


2
щоразу, коли ви захоплюєте помилку, On Error Gotoвам також потрібно її впорядкувати, я думаю Err.Clear, що у вашому коді немає.
Máté Juhász

За яким рядком ви отримуєте помилку?
Кайл

@ MátéJuhász правильний - ви повинні впоратися з помилкою. Не робіть нічого з цього on error resume next.
Райстафаріан

Відповіді:


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

Err.clear не вирішує мою проблему.
цікаво K

Err.clear не вирішує мою проблему. Але з наведеного вище прикладу я змінюю код і додаю ще одну мітку. Це вирішує проблему ... Дякую!
цікаво K
Використовуючи наш веб-сайт, ви визнаєте, що прочитали та зрозуміли наші Політику щодо файлів cookie та Політику конфіденційності.
Licensed under cc by-sa 3.0 with attribution required.