3x On Error Goto Weiter ?

Hi,
ich habe ein kleines Script gehabt, das auch funktionierte.
Per Formel erzeuge ich an einigen Stellen DIV0! Fehler, per SpecialCells16 selektiere ich dann eben diese Zellen und kann ohne Schleife - sehr schnell - weiter machen.
Problem: Falls es keine SpecialCells16 gibt, steigt die Selektion mit einem Fehler aus. Da behelfe ich mir, indem ich ein "on error goto weiter" drum herum setze.
Da das Makro natürlich eine Fehlerbehandlung hat, gehe ich direkt nach dem SpecialCells16-Befehl mit "on error goto fehler" wieder auf ebendiese.
Das klappt auch - aber nur einmal. Bitte schaut euch einmal mein Makro an. Das erste "goto weiter" funktioniert, bei "goto weiter2" steigt er aus (im SpecialCells Befehl). Klammere ich den "goto weiter" Block komplett aus, läuft der "goto weiter2" Block sauber durch - im "goto weiter3" Block steigt er dann bei SpecialCells wieder aus.
Ich möchte jetzt nicht hören, dass ich keine Fehlerwerte verursachen soll :-) Kann mir jemand erklären, wieso der "On Error Goto" Befehl sich nicht wiederholen lässt?
LG,
Klaus M.

Sub ScanArchivFertigMelden()
On Error GoTo fehler
Const APPNAME = "Scan Archiv Fertig melden"
Dim lRow As Long
With ScanArchiv
.Range("L2:L" & lRow).FormulaR1C1 = "=1/IF(RC7=""fertig"",0,1)" 'provoziert Div0! Fehler
On Error GoTo weiter    'Falls keine SpecialCells Type 16 gefunden werden!
.Columns("L:L").SpecialCells(xlCellTypeFormulas, 16).Offset(0, 1).FormulaR1C1 = "=MATCH(RC1, _
RepairList!C1,)"
weiter:
On Error GoTo fehler
End With
With RepairList
On Error GoTo weiter2   'Falls keine SpecialCells Type 16 gefunden werden!
For Each myRng In .Columns("AH:AH").SpecialCells(xlCellTypeFormulas, 16)
Call OutByDoubleClick(myRng.Row)
Next myRng
weiter2:
On Error GoTo fehler
Call DoResetAutofilter(RepairList, 1, 12, 6)
.Range("$A$6:$L$" & lRow).AutoFilter Field:=10, Criteria1:="="
On Error GoTo weiter3 'Falls keine Special Cells Visible vorhanden sind
For Each myRng In .Range("$M$7:$M$" & lRow).SpecialCells(xlCellTypeVisible)
myRng.FormulaR1C1 = "=IFERROR(IF(LOOKUP(2,1/(ScanArchiv!C[-12]=RC[-12]),ScanArchiv!C[-2] _
)="""","""",LOOKUP(2,1/(ScanArchiv!C[-12]=RC[-12]),ScanArchiv!C[-2])),"""")"
Next myRng
weiter3:
On Error GoTo fehler
End With
'*** Fehlerbehandlung
Err.Clear
fehler:
If Err.Number  0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description
Err.Clear
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ooooooops,
da fehlt noch was.

Sub ScanArchivFertigMelden()

    Const APPNAME = "Scan Archiv Fertig melden"

    On Error GoTo fehler

    Dim lRow As Long
    Dim myRng As Range
    Dim objRange As Range

    With ScanArchiv
        .Range("L2:L" & lRow).FormulaR1C1 = "=1/IF(RC7=""fertig"",0,1)" 'provoziert Div0! Fehler
        Set objRange = .Columns("L:L").SpecialCells(xlCellTypeFormulas, xlErrors)
        If Not objRange Is Nothing Then _
            objRange.Offset(0, 1).FormulaR1C1 = "=MATCH(RC1,RepairList!C1,)"
    End With

    With RepairList
        Set objRange = Nothing
        Set objRange = .Columns("AH:AH").SpecialCells(xlCellTypeFormulas, xlErrors)
        If Not objRange Is Nothing Then
            For Each myRng In objRange
                ' Call OutByDoubleClick(myRng.Row)
            Next myRng
        End If

        ' Call DoResetAutofilter(RepairList, 1, 12, 6)
        .Range("$A$6:$L$" & lRow).AutoFilter Field:=10, Criteria1:="="
        Set objRange = Nothing
        Set objRange = .Range("$M$7:$M$" & lRow).SpecialCells(xlCellTypeVisible)
        If Not objRange Is Nothing Then
            For Each myRng In objRange
                myRng.FormulaR1C1 = "=IFERROR(IF(LOOKUP(2,1/(ScanArchiv!C[-12]=RC[-12]),ScanArchiv!C[-2]" & _
                    ")="""","""",LOOKUP(2,1/(ScanArchiv!C[-12]=RC[-12]),ScanArchiv!C[-2])),"""")"
            Next myRng
        End If

    End With

    Exit Sub

    fehler:
    MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
        & "Fehlernummer: " & Err.Number & vbLf & Err.Description
    Resume Next

End Sub

Gruß
Nepumuk

'*** Fehlerbehandlung Err.Clear fehler: If Err.Number = 1004 Then Resume Next Else If Err.Number 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description Err.Clear End If

Sub ScanArchivFertigMelden() On Error GoTo fehler Const APPNAME = "Scan Archiv Fertig melden" Dim lRow As Long With ScanArchiv .Range("L2:L" & lRow).FormulaR1C1 = "=1/IF(RC7=""fertig"",0,1)" 'provoziert Div0! Fehler On Error GoTo weiter 'Falls keine SpecialCells Type 16 gefunden werden! .Columns("L:L").SpecialCells(xlCellTypeFormulas, 16).Offset(0, 1).FormulaR1C1 = "=MATCH(RC1, _ RepairList!C1,)" weiter: On Error GoTo fehler RepairsOut CommentsOut '*** Fehlerbehandlung Err.Clear fehler: If Err.Number 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description & vbLf & vbLf & "Bitte Klaus _ Meyer von der Twer (AV) kontaktieren!" Err.Clear End Sub Sub RepairsOut() Dim myRng As Range With RepairList On Error GoTo weiter2 'Falls keine SpecialCells Type 16 gefunden werden! For Each myRng In .Columns("AH:AH").SpecialCells(xlCellTypeFormulas, 16) Call OutByDoubleClick(myRng.Row) Next myRng End With weiter2: End Sub Sub CommentsOut() Dim myRng As Range Dim lRow As Long With RepairList Call DoResetAutofilter(RepairList, 1, 12, 6) .Range("$A$6:$L$" & lRow).AutoFilter Field:=10, Criteria1:="=" On Error GoTo weiter3 'Falls keine Special Cells Visible vorhanden sind For Each myRng In .Range("$M$7:$M$" & lRow).SpecialCells(xlCellTypeVisible) myRng.FormulaR1C1 = "=IFERROR(IF(LOOKUP(2,1/(ScanArchiv!C[-12]=RC[-12]),ScanArchiv!C[-2] _ )="""","""",LOOKUP(2,1/(ScanArchiv!C[-12]=RC[-12]),ScanArchiv!C[-2])),"""")" Next myRng End With weiter3: On Error GoTo fehler End Sub

Sub ScanArchivFertigMelden() On Error GoTo fehler Const APPNAME = "Scan Archiv Fertig melden" Dim rSC As Range Dim lRow As Long With ScanArchiv .Range("L2:L" & lRow).FormulaR1C1 = "=1/IF(RC7=""fertig"",0,1)" 'provoziert Div0! Fehler On Error Resume Next 'Falls keine SpecialCells Type 16 gefunden werden! Set rSC = .Columns("L:L").SpecialCells(xlCellTypeFormulas, 16) On Error GoTo 0 If Not rSC Is Nothing Then rSC.Offset(0, 1).FormulaR1C1 = "=MATCH(RC1, RepairList!C1,)" End If weiter: End With '...

dim FehlerZellen as range set FehlerZellen = nothing ON Error resume next set Fehlerzellen = ...Specialcells(,16) On error goto 0 if Fehlerzellen is Nothing then Code wenn kein Fehler vorhanden Else Code wenn Zellen mit Fehler vorliegen End if

Sub ScanArchivFertigMelden() On Error GoTo fehler Range("L2:L" & lRow).FormulaR1C1 = "=1/IF(RC7=""fertig"",0,1)" 'provoziert Div0! Fehler On Error GoTo weiter 'Falls keine SpecialCells Type 16 gefunden werden! irgendwas mitSpecialCells(xlCellTypeFormulas, 16) weiter: On Error GoTo 0 On Error GoTo fehler On Error GoTo weiter2 'Falls keine SpecialCells Type 16 gefunden werden! For Each myRng In .Columns("AH:AH").SpecialCells(xlCellTypeFormulas, 16) [...] weiter2: On Error GoTo 0 On Error GoTo fehler On Error GoTo weiter3 'Falls keine Special Cells Visible vorhanden sind For Each myRng In .Range("$M$7:$M$" & lRow).SpecialCells(xlCellTypeVisible) [..] weiter3: On Error GoTo 0 On Error GoTo fehler '*** Fehlerbehandlung Err.Clear fehler: If Err.Number 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _ & "Fehlernummer: " & Err.Number & vbLf & Err.Description Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

174 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3x On Error Goto Weiter ?

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

174 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread