# Suchfunktion abfangen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: # Suchfunktion abfangen
von: Nikolaus
Geschrieben am: 20.04.2005 12:08:37
Hallo,
ich schreibe gerade ein Makro, in dem ich per Suchfunktion einen String suche. Solange der String gefunden werden kann, ist alles in Ordnung. Gibt es den String jedoch in der Tabelle nicht, stürzt das Makro ab. Hat jemand einen guten Tipp für mich?
Vielen Dank, Nikolaus
Code:


Sub FindATB_v2()
'
' FindATB Macro
' by Nikolaus Schumacher
' Sucht ATB-Nummer aus einer Tabelle
    ' Variables:
    Dim Cntr_No, ATB_No, Response, MyStr, YesNo, Status
    YesNo = vbYes ' Erst einmal soll der Loop loslaufen
    
    Do Until YesNo = vbNo ' Loop-Anfang
        
    ' Ask for input...
    Cntr_No = InputBox("Bitte Containernummer eingeben." & Chr(13) & "Ein Bruchstück (z.B. '123456' kann ausreichen!")
    If Cntr_No = "" Then GoTo ENDE ' So fange ich den [Cancel]-Button ab
    
    ' .. go looking for it.
    Cells.Find(What:=Cntr_No, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).Activate
    
        ' Fehlerbehandlung, wenn der String nicht gefunden werden kann...
        '
        ' Hier brauche ich ein wenig Unterstützung...
        '
        
        If Status = False Then _
        MsgBox ("Fehler")
       
    ActiveCell.Offset(0, 1).Activate      ' In Feld mit ATB-Nr wechseln
    ATB_No = Mid(ActiveCell, 7, 7)        ' Die richtigen Zahlen suchen
    MyStr = Format(ATB_No, "0 00 00 -00") ' Suchergebnis formatieren
    
    YesNo = MsgBox("Die ATB-Nr. lautet: '" & MyStr & "' - Soll eine weitere Nummer gesucht werden?", vbYesNo)
    
    Loop ' Loop-Ende
    
    ' Ende vom Makro...
ENDE:
End Sub

Bild

Betrifft: AW: # Suchfunktion abfangen
von: marcl
Geschrieben am: 20.04.2005 12:16:17
Hallo Nikolaus,

Sub FindATB_v2()
'
' FindATB Macro
' by Nikolaus Schumacher
' Sucht ATB-Nummer aus einer Tabelle
    ' Variables:
    Dim Cntr_No, ATB_No, Response, MyStr, YesNo, Status
    YesNo = vbYes ' Erst einmal soll der Loop loslaufen
    
    Do Until YesNo = vbNo ' Loop-Anfang
        
    ' Ask for input...
    Cntr_No = InputBox("Bitte Containernummer eingeben." & Chr(13) & "Ein Bruchstück (z.B. '123456' kann ausreichen!")
    If Cntr_No = "" Then GoTo ENDE ' So fange ich den [Cancel]-Button ab
    
' Fehlermeldung
On Error Goto Errorhandler
    ' .. go looking for it.
    Cells.Find(What:=Cntr_No, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).Activate
    ActiveCell.Offset(0, 1).Activate      ' In Feld mit ATB-Nr wechseln
    ATB_No = Mid(ActiveCell, 7, 7)        ' Die richtigen Zahlen suchen
    MyStr = Format(ATB_No, "0 00 00 -00") ' Suchergebnis formatieren
    
    YesNo = MsgBox("Die ATB-Nr. lautet: '" & MyStr & "' - Soll eine weitere Nummer gesucht werden?", vbYesNo)
    
    Loop ' Loop-Ende
    
    ' Ende vom Makro...
ENDE:
Exit Sub
Errorhandler:
        MsgBox ("Fehler")
End Sub


bitte

marcl
Bild

Betrifft: AW: # Suchfunktion abfangen
von: Nikolaus
Geschrieben am: 20.04.2005 12:27:33
Danke, so geht das super!
Schönen Tag noch...
~~~~~~~~~~~~~~~~~~~~~

Sub FindATB_v2()
'
' FindATB Macro
' by Nikolaus Schumacher
' Sucht ATB-Nummer aus einer Tabelle
    ' Variables:
    Dim Cntr_No, ATB_No, Response, MyStr, YesNo, Status
    YesNo = vbYes ' Erst einmal soll der Loop loslaufen
    
    Do Until YesNo = vbNo ' Loop-Anfang
        
START:
    ' Ask for input...
    Cntr_No = InputBox("Bitte Containernummer eingeben." & Chr(13) & "Ein Bruchstück (z.B. '123456' kann ausreichen!")
    If Cntr_No = "" Then GoTo ENDE ' So fange ich den [Cancel]-Button ab
    
    ' Fehlermeldung
    On Error GoTo Errorhandler
    ' .. go looking for it.
    Cells.Find(What:=Cntr_No, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).Activate
    
        ' Fehlerbehandlung, wenn der String nicht gefunden werden kann...
        '
        ' Hier brauche ich ein wenig Unterstützung...
        '
        
        'If Status = False Then _
        'MsgBox ("Fehler")
       
    ActiveCell.Offset(0, 1).Activate      ' In Feld mit ATB-Nr wechseln
    ATB_No = Mid(ActiveCell, 7, 7)        ' Die richtigen Zahlen suchen
    MyStr = Format(ATB_No, "0 00 00 -00") ' Suchergebnis formatieren
    
    YesNo = MsgBox("Die ATB-Nr. lautet: '" & MyStr & "' - Soll eine weitere Nummer gesucht werden?", vbYesNo)
    
    Loop ' Loop-Ende
    
    ' Normaler Ausstieg aus dem Makro
ENDE:
    GoTo E2
    ' Abfangen von Fehl-Strings
Errorhandler:
    MsgBox ("Diesen String gibt es nicht...")
    GoTo START
    
    ' Makro Ende
E2:
End Sub

Bild

Betrifft: AW: # Suchfunktion abfangen
von: Nikolaus
Geschrieben am: 20.04.2005 12:29:08
Danke, so geht das super!
Schönen Tag noch...
~~~~~~~~~~~~~~~~~~~~~

Sub FindATB_v2()
'
' FindATB Macro
' by Nikolaus Schumacher
' Sucht ATB-Nummer aus einer Tabelle
    ' Variables:
    Dim Cntr_No, ATB_No, Response, MyStr, YesNo, Status
    YesNo = vbYes ' Erst einmal soll der Loop loslaufen
    
    Do Until YesNo = vbNo ' Loop-Anfang
        
START:
    ' Ask for input...
    Cntr_No = InputBox("Bitte Containernummer eingeben." & Chr(13) & "Ein Bruchstück (z.B. '123456' kann ausreichen!")
    If Cntr_No = "" Then GoTo ENDE ' So fange ich den [Cancel]-Button ab
    
    ' Fehlermeldung
    On Error GoTo Errorhandler
    ' .. go looking for it.
    Cells.Find(What:=Cntr_No, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).Activate
    ActiveCell.Offset(0, 1).Activate      ' In Feld mit ATB-Nr wechseln
    ATB_No = Mid(ActiveCell, 7, 7)        ' Die richtigen Zahlen suchen
    MyStr = Format(ATB_No, "0 00 00 -00") ' Suchergebnis formatieren
    
    YesNo = MsgBox("Die ATB-Nr. lautet: '" & MyStr & "' - Soll eine weitere Nummer gesucht werden?", vbYesNo)
    
    Loop ' Loop-Ende
    
    ' Normaler Ausstieg aus dem Makro
ENDE:
    GoTo E2
    ' Abfangen von Fehl-Strings
Errorhandler:
    MsgBox ("Diesen String gibt es nicht...")
    GoTo START
    
    ' Makro Ende
E2:
End Sub

 Bild

Beiträge aus den Excel-Beispielen zum Thema "# Suchfunktion abfangen"