एक्सेल vba कोड में मेरी एक प्रक्रिया है। इसमें मैं 'ON ERROR ....' सिंटैक्स का उपयोग करता हूं।
प्रक्रिया ON ERROR RESUME NEXTसभी त्रुटि को छोड़ देती है।
लेकिन कुछ बिंदु पर मैं उस स्थिति ON ERROR RESUME NEXTको ON ERROR GOTO NX{NX से लेबल करना चाहता हूं उसी प्रक्रिया में परिभाषित किया गया है।} और फिर से इसे बदल देंON ERROR RESUME NEXT
पहली बार इसका काम पूरी तरह से लेकिन जब अगले मूल्य के लिए कोड लूप होता है तो यह किसी भी त्रुटि पर रुक जाता है और चेतावनी संदेश दिखाता है। { त्रुटि गोटो पर 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
आप किस लाइन पर त्रुटि प्राप्त कर रहे हैं?
—
काइल
@ MátéJuhász सही है - आपको त्रुटि को संभालना होगा। इनमें से कुछ भी मत करो
—
Raystafarian
on error resume next।
On Error Gotoइसे प्रबंधित करने की भी आवश्यकता होती है, मुझे लगताErr.Clearहै कि यह आपके कोड से गायब है।