Suchfunktion über msg Box

Hallo Excelfreunde,
ich möchte eine Datenbank mit folgendem Makro, das ebenfalls aus diesem Forum ist, durchsuchen.Wie kann ich es ereichen das die Eingabebox nach finden der Übereinstimmung noch den letzten Suchbegriff anzeigt.
Falls es mehrere Übereinstimmungen gibt kann ich weitersuchen ohne den Suchbegriff neu einzugeben.

Sub Suchen()
Dim rngFind As Range
Dim strFind As String
strFind = InputBox("Geben Sie den Suchbegriff ein:", "Eingabe Materialdatenbank")
If strFind = "" Then Exit Sub
Set rngFind = Cells.Find(strFind, LookAt:=xlPart, LookIn:=xlFormulas)
If rngFind Is Nothing Then
Beep
MsgBox "Es wurde keine Übereinstimmung gefunden!"
Exit Sub
End If
rngFind.Select
End Sub

Vielen Dank im voraus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Mike,
der Beitrag hat mir sehr geholfen, Danke.
Das Problem ist nur wenn ich einen Suchbegriff eingebe der nicht vorhanden ist hängt sich das Makro auf und ich komme nur noch mit ESC raus.Wo liegt der Fehler??

Gruss Andreas

Public Sub suchen()
Dim Zelle As Range, Suchbegriff As String, Adresse As String, zaehler As Integer
Dim index As Integer, Feld() As String, Tabelle() As Integer, Zeile_Spalte() As String
Suchbegriff = InputBox("Suchbegriff eingeben", "Eingabe")
If Suchbegriff <> "" Then
For index = 1 To Worksheets.Count
With Sheets(index).Cells
Set Zelle = .Find(What:=Trim(Suchbegriff), LookAt:=xlPart)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
zaehler = zaehler + 1
ReDim Preserve Feld(1 To zaehler)
ReDim Preserve Tabelle(1 To zaehler)
ReDim Preserve Zeile_Spalte(1 To zaehler)
Feld(zaehler) = Sheets(index).Name & " Spalte " & Zelle.Column & " Zeile " & Zelle.Row
Tabelle(zaehler) = index
Zeile_Spalte(zaehler) = Zelle.Address
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
End With
Next
If zaehler = 0 Then MsgBox Suchbegriff & " wurde nicht gefunden", 64, "Information" _
Else If MsgBox(Suchbegriff & " wurde " & CStr(zaehler) & " mal gefunden." & vbNewLine & "Fundstellen anzeigen?", 68, "Information") = 7 Then Exit Sub
Do
For index = 1 To zaehler
Sheets(Tabelle(index)).Select
Range(Zeile_Spalte(index)).Select
ActiveWindow.ScrollColumn = Selection.Column
ActiveWindow.ScrollRow = Selection.Row
If index < zaehler Then
If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Weitere anzeigen?", 68, "Information") = 7 Then Exit Sub
Else
If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Nochmal anzeigen?", 68, "Information") = 7 Then Exit Do
End If
Next
Loop
End If
End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread