44 Aufrufe
Gefragt in Tabellenkalkulation von tigershogun2310 Einsteiger (10 Punkte)
Hallo habe hier im Forum folgendes Makro gefunden

Sub suchen()
Dim strSuch As String, ws As Integer, rng As Range, strNeu As String
Start:
Do
strSuch = InputBox("Wonach wird gesucht?" & Chr(13) & "Mindestens 3 Buchstaben angeben!")
If strSuch = "" Or Len(strSuch) = 0 Then Exit Sub
Loop While Len(strSuch) < 3
ws = 1
Do While ws <= Worksheets.Count
Sheets(ws).Select
Set rng = Cells.Find(What:=strSuch, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If rng Is Nothing And ws = Worksheets.Count Then
strNeu = MsgBox("Keine Begriff gefunden!" & Chr(13) & "Möchten sie erneut suchen?", vbYesNo)
If strNeu = vbNo Then
Exit Sub
Else
GoTo Start
End If
ElseIf rng Is Nothing And ws < Worksheets.Count Then
ws = ws + 1
Else
rng.Select
Exit Sub
End If
Loop
End Sub

Das Makro funktioniert nur bis zum ersten Treffer.

Kann mir jemand da weiter helfen

Ich Tabellenblätter die über eine Makrosuchfunktion komplett nach einem einzugebenden Suchbegriff durchsuchen möchte. Hier soll der erste Treffer angezeigt werden, anschließend die Suche jedoch fortgesetzt werden, falls der Treffer oder die zugehörigen Informationen nicht gänzlich zutreffend sind und das solange bis der Treffer ausreichend ist oder letztendlich die Mappe komplett durchsucht wurde.

Gruß Lutz

2 Antworten

0 Punkte
Beantwortet von m-o Profi (13.2k Punkte)
ausgewählt von halfstone
 
Beste Antwort

Hallo Lutz,

probiere mal das folgende Makro:

Sub suchen_neu()
Dim strSuch As String
Dim ws As Integer
Dim rngSuch As Range
Dim strNeu As String
Dim lngGefunden As Long
Dim strGefunden As String
Dim lngZaehler As Long

Start:

Do
  strSuch = InputBox("Wonach wird gesucht?" & Chr(13) & "Mindestens 3 Buchstaben angeben!")
  If strSuch = "" Or Len(strSuch) = 0 Then Exit Sub
Loop While Len(strSuch) < 3

For ws = 1 To ThisWorkbook.Worksheets.Count

 With Worksheets(ws)
       
   lngGefunden = 0
   strGefunden = ""
 
  Do
   Set rngSuch = Nothing
   Set rngSuch = .Cells.Find(What:=strSuch, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
      xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
      , SearchFormat:=False)
   
    If Not rngSuch Is Nothing Then
     lngGefunden = lngGefunden + 1
     lngZaehler = lngZaehler + 1
     If lngGefunden = 1 Then
       strGefunden = rngSuch.Address
      Else
        If strGefunden = rngSuch.Address Then Exit Do
      End If
     .Select
     rngSuch.Select
   
     strNeu = MsgBox("Soll weitergesucht werden?", 36, "Weitersuchen?")
     If strNeu = vbNo Then Exit Sub
    End If
     
   Loop Until rngSuch Is Nothing
 End With
 
Next ws

If lngZaehler = 0 Then
  strNeu = MsgBox("Keine Begriff gefunden!" & Chr(13) & "Möchten sie erneut suchen?", vbYesNo)
  If strNeu = vbYes Then GoTo Start
End If

End Sub

Du wirst nach jedem Suchergebnis gefragt, ob die Suche fortgeführt werden soll. Wurden alle Blätter der Arbeitsmappe durchsucht, endet die Suche. Ob ein Treffer ausreichend ist, muss letztlich der Nutzer entscheiden, da alle Treffer angezeigt werden, in denen der Suchbegriff enthalten ist.

Gruß

M.O.

0 Punkte
Beantwortet von tigershogun2310 Einsteiger (10 Punkte)
Hallo

vielen Dank , funktioniert super , auch das mit des Infobox zur Weitersuche oder Abbruch ist echt schön

werde es bei allen meinen Tabellen einbauen.

Vielen Dank

Gruß Lutz
...