Supportnet / Forum / Tabellenkalkulation
Suchfunktion unter Excel
Frage
Hallo zusammen!
Ich möchte gerne eine Freitextsuche in Excel erstellen.
Ein Makro, welches FAST alle meine Wünsche habe ich schon (gefunden).
Das einzige, was mir daran fehlt ist, dass nur in dem jeweils geöffnenten Tabellenblatt gesucht wird.
Schön wäre es, wenn die Suche über alle Blätter der Arbeitsmappe laufen würde!
Da ich von VBA aber nur rudimentäre Ahnung habe wende ich mich an Euch!
Vielleicht kann ja jemand das Makro entsprechend anpassen?
(Das Makro ist NICHT von mir!!)
[b]Sub Suchen_Click()
Dim strSuche As String, erg As Range, firstAddress As String, gefunden() As String
Dim index1 As Integer, index2 As Integer, text As String, schalter As Integer
schalter = 4
text = "Die nächste Übereinstimmung anzeigen?"
Do
strSuche = InputBox("Mindestens die 3 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 2
Set erg = Range("A4:IV65536").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, oder suchen Sie den Begriff manuell in der Tabelle."
Else
firstAddress = erg.Address
Do
index1 = index1 + 1
ReDim Preserve gefunden(1 To index1)
gefunden(index1) = erg.Address
Set erg = Range("A4:IV65536").FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
Range(gefunden(index2)).Select
ActiveWindow.ScrollRow = Selection.Row
ActiveWindow.ScrollColumn = Selection.Column
If MsgBox(CStr(index2) & ". von " & CStr(index1) & " gefundenen Übereinstimmungen des Suchbegriffes." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
End If
End Sub[/b]
Antwort 1 von Beverly
Hi,
ohne jetzt weiter auf deinen Code eingehen zu wollen, versuche es so
Bis später,
Karin
ohne jetzt weiter auf deinen Code eingehen zu wollen, versuche es so
Sub Suchen_Click()
Dim strSuche As String, erg As Range, firstAddress As String, gefunden() As String
Dim index1 As Integer, index2 As Integer, text As String, schalter As Integer
schalter = 4
text = "Die nächste Übereinstimmung anzeigen?"
With ActiveSheet
Do
strSuche = InputBox("Mindestens die 3 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 2
Set erg = .Range("A4:IV65536").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, oder suchen Sie den Begriff manuell in der Tabelle."
Else
firstAddress = erg.Address
Do
index1 = index1 + 1
ReDim Preserve gefunden(1 To index1)
gefunden(index1) = erg.Address
Set erg = .Range("A4:IV65536").FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
.Range(gefunden(index2)).Select
ActiveWindow.ScrollRow = Selection.Row
ActiveWindow.ScrollColumn = Selection.Column
If MsgBox(CStr(index2) & ". von " & CStr(index1) & " gefundenen Übereinstimmungen des Suchbegriffes." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
End If
End With
End Sub
Bis später,
Karin
Antwort 2 von sickboy
Hi Karin!
Danke für die Antwort! Es funktioniert leider nicht.
Wenn ich z.B. vom Tabellenblatt 1 aus die Suche starte wird mir immer direkt angezeigt, dass nichts gefunden wurde.
Danke für die Antwort! Es funktioniert leider nicht.
Wenn ich z.B. vom Tabellenblatt 1 aus die Suche starte wird mir immer direkt angezeigt, dass nichts gefunden wurde.
Antwort 3 von Beverly
Hi,
sorry, ich hatte deine Frage falsch verstanden. Mit diesem Code sollte es jetzt funktonieren
Bis später,
Karin
sorry, ich hatte deine Frage falsch verstanden. Mit diesem Code sollte es jetzt funktonieren
Sub Suchen_Click()
Dim strSuche As String, erg As Range, firstAddress As String, gefunden() As String
Dim index1 As Integer, index2 As Integer, text As String, schalter As Integer
Dim wsTabelle As Worksheet
schalter = 4
text = "Die nächste Übereinstimmung anzeigen?"
Do
strSuche = InputBox("Mindestens die 3 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 2
For Each wsTabelle In ThisWorkbook.Worksheets
Set erg = wsTabelle.Range("A4:IV65536").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, oder suchen Sie den Begriff manuell in der Tabelle."
Else
firstAddress = erg.Address
Do
index1 = index1 + 1
ReDim Preserve gefunden(2, 1 To index1)
gefunden(1, index1) = wsTabelle.Name
gefunden(2, index1) = erg.Address
Set erg = wsTabelle.Range("A4:IV65536").FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
End If
Next wsTabelle
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
Application.Goto Reference:=Worksheets(gefunden(1, index2)).Range(gefunden(2, index2)), _
scroll:=True
If MsgBox(CStr(index2) & ". von " & CStr(index1) & " gefundenen Übereinstimmungen des Suchbegriffes." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
End Sub
Bis später,
Karin
Antwort 4 von sickboy
Hallo!
Diese Version ist deutlich besser...funktioniert aber immer noch nicht so 100%.
Erstmal aber schonmal 1000 DANK für Deine Hilfe! Wirklich wirklich nett!!!
Ich werde vielleicht mal etwas genauer:
Ich habe (bisher) 5 Tabellenblätter in denen gesucht werden soll (kann man die Suche eigentlich von vornherein auch auf diese Blätter beschränken?? Das wäre super!).
Mein "Such-Button" ist auf dem Blatt 1. Ansonsten befinden sich auf dem Blatt ausschließlich weitere Button.
Wenn ich jetzt z.B. nach "Patient" suche sagt mir Excel, zunächst 4 mal, dass nichtsgefunden wurde. Nach der viertten Bestätigung mit OK springt er dann zum "1. von 21gefundenen Einträgen". Ab da klappt es also wunderbar!
Konkrete Fragen wären also:
Diese Version ist deutlich besser...funktioniert aber immer noch nicht so 100%.
Erstmal aber schonmal 1000 DANK für Deine Hilfe! Wirklich wirklich nett!!!
Ich werde vielleicht mal etwas genauer:
Ich habe (bisher) 5 Tabellenblätter in denen gesucht werden soll (kann man die Suche eigentlich von vornherein auch auf diese Blätter beschränken?? Das wäre super!).
Mein "Such-Button" ist auf dem Blatt 1. Ansonsten befinden sich auf dem Blatt ausschließlich weitere Button.
Wenn ich jetzt z.B. nach "Patient" suche sagt mir Excel, zunächst 4 mal, dass nichtsgefunden wurde. Nach der viertten Bestätigung mit OK springt er dann zum "1. von 21gefundenen Einträgen". Ab da klappt es also wunderbar!
Konkrete Fragen wären also:
- 1) Kann man die Suche auf einige Tabellenblätter beschränken?
- 2) Irgendeine Idee wieso ich erstmal 4 mal gesagt bekomme, dass nicht gefunden wurde?
Antwort 5 von Beverly
Hi,
ja, man kann die Suche einschränken, indem man den Tabellennamen im Code festglegt, in denen gesucht werden soll
Die Tabellenamen musst du natürlich anpassen.
Bis später,
Karin
ja, man kann die Suche einschränken, indem man den Tabellennamen im Code festglegt, in denen gesucht werden soll
Sub Suchen_Click()
Dim strSuche As String, erg As Range, firstAddress As String, gefunden() As String
Dim index1 As Integer, index2 As Integer, text As String, schalter As Integer
Dim wsTabelle As Worksheet
schalter = 4
text = "Die nächste Übereinstimmung anzeigen?"
Do
strSuche = InputBox("Mindestens die 3 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 2
For Each wsTabelle In ThisWorkbook.Worksheets
If wsTabelle.Name = "Tabelle2" Or wsTabelle.Name = "Tabelle4" Or wsTabelle.Name = "Tabelle5" Then
Set erg = wsTabelle.Range("A4:IV65536").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox wsTabelle.Name & vbCrLf & vbCrLf & "Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet." & vbCrLf & "Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein," & vbCrLf & "oder suchen Sie den Begriff manuell in der Tabelle.", , "Suchbegriff wurde nicht gefunden in:"
Else
firstAddress = erg.Address
Do
index1 = index1 + 1
ReDim Preserve gefunden(2, 1 To index1)
gefunden(1, index1) = wsTabelle.Name
gefunden(2, index1) = erg.Address
Set erg = wsTabelle.Range("A4:IV65536").FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
End If
End If
Next wsTabelle
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
Application.Goto Reference:=Worksheets(gefunden(1, index2)).Range(gefunden(2, index2)), _
scroll:=True
If MsgBox(gefunden(1, index2) & vbCrLf & vbCrLf & CStr(index2) & ". von " & CStr(index1) & " gefundenen Übereinstimmungen des Suchbegriffes." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
End Sub
Die Tabellenamen musst du natürlich anpassen.
Bis später,
Karin
Antwort 6 von sickboy
SUPER!!!
Perfekt! Genauso wie ich es brauche! Ich bin schwer begeistert!!
Fühl Dich virtuell zu nem Kaffee o.ä. eingeladen!!
DANKE!!!!
Perfekt! Genauso wie ich es brauche! Ich bin schwer begeistert!!
Fühl Dich virtuell zu nem Kaffee o.ä. eingeladen!!
DANKE!!!!
Antwort 7 von Beverly
Hi,
danke für die Einladung. Ich nehme aber lieber ein Eis mit viel Sahne. ;-)))
Freut mich, dass alles deinen Wünschen entsprechend funktionert.
Bis später,
Karin
danke für die Einladung. Ich nehme aber lieber ein Eis mit viel Sahne. ;-)))
Freut mich, dass alles deinen Wünschen entsprechend funktionert.
Bis später,
Karin
Antwort 8 von sickboy
*grins*
Auch dazu bist Du natürlich herzlich eingeladen!
Auch dazu bist Du natürlich herzlich eingeladen!
Antwort 9 von sickboy
Tja, ein kleines Problemchen habe ich leider doch noch gefunden!
Wenn ich einen Suchbegriff eingebe, den es nirgenwo gibt (z.B. qkdfalkwef) wird zwar brav das ganze Arbeitsblatt durchsucht, am Ende bekomme ich aber eine Fehlermeldung (Laufzeitfehler 9). Im Code wird folgendes angemarkert:
Sub Suche()
Dim strSuche As String, erg As Range, firstAddress As String, gefunden() As String
Dim index1 As Integer, index2 As Integer, text As String, schalter As Integer
Dim wsTabelle As Worksheet
schalter = 4
text = "Die nächste Übereinstimmung anzeigen?"
Do
strSuche = InputBox("Mindestens die 3 ersten Buchstaben des Suchbegriffes. Groß-/Kleinschreibung wird nicht beachtet.", "Suchen")
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 2
For Each wsTabelle In ThisWorkbook.Worksheets
If wsTabelle.Name = "Führung" Or wsTabelle.Name = "Mitarbeiter" Or wsTabelle.Name = "Patienten" Or wsTabelle.Name = "unterstüzende Prozesse" Or wsTabelle.Name = "Qualitätsmessung" Then
Set erg = wsTabelle.Range("A4:IV65536").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox wsTabelle.Name & vbCrLf & "Überprüfen Sie daher bitte die Schreibweise und geben den Suchbegriff erneut ein," & vbCrLf & "oder suchen Sie den Begriff manuell in der Tabelle.", , "Suchbegriff wurde nicht gefunden in:"
Else
firstAddress = erg.Address
Do
index1 = index1 + 1
ReDim Preserve gefunden(2, 1 To index1)
gefunden(1, index1) = wsTabelle.Name
gefunden(2, index1) = erg.Address
Set erg = wsTabelle.Range("A4:IV65536").FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
End If
End If
Next wsTabelle
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
Application.Goto Reference:=Worksheets(gefunden(1, index2)).Range(gefunden(2, index2)), _
Scroll:=True
If MsgBox(gefunden(1, index2) & vbCrLf & vbCrLf & CStr(index2) & ". von " & CStr(index1) & " gefundenen Übereinstimmungen des Suchbegriffes." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
End Sub
Irgeneine Ahnung wo das Problem liegt? Ansonsten ist alles wirklich super!
Wenn ich einen Suchbegriff eingebe, den es nirgenwo gibt (z.B. qkdfalkwef) wird zwar brav das ganze Arbeitsblatt durchsucht, am Ende bekomme ich aber eine Fehlermeldung (Laufzeitfehler 9). Im Code wird folgendes angemarkert:
Sub Suche()
Dim strSuche As String, erg As Range, firstAddress As String, gefunden() As String
Dim index1 As Integer, index2 As Integer, text As String, schalter As Integer
Dim wsTabelle As Worksheet
schalter = 4
text = "Die nächste Übereinstimmung anzeigen?"
Do
strSuche = InputBox("Mindestens die 3 ersten Buchstaben des Suchbegriffes. Groß-/Kleinschreibung wird nicht beachtet.", "Suchen")
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 2
For Each wsTabelle In ThisWorkbook.Worksheets
If wsTabelle.Name = "Führung" Or wsTabelle.Name = "Mitarbeiter" Or wsTabelle.Name = "Patienten" Or wsTabelle.Name = "unterstüzende Prozesse" Or wsTabelle.Name = "Qualitätsmessung" Then
Set erg = wsTabelle.Range("A4:IV65536").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox wsTabelle.Name & vbCrLf & "Überprüfen Sie daher bitte die Schreibweise und geben den Suchbegriff erneut ein," & vbCrLf & "oder suchen Sie den Begriff manuell in der Tabelle.", , "Suchbegriff wurde nicht gefunden in:"
Else
firstAddress = erg.Address
Do
index1 = index1 + 1
ReDim Preserve gefunden(2, 1 To index1)
gefunden(1, index1) = wsTabelle.Name
gefunden(2, index1) = erg.Address
Set erg = wsTabelle.Range("A4:IV65536").FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
End If
End If
Next wsTabelle
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
Application.Goto Reference:=Worksheets(gefunden(1, index2)).Range(gefunden(2, index2)), _
Scroll:=True
If MsgBox(gefunden(1, index2) & vbCrLf & vbCrLf & CStr(index2) & ". von " & CStr(index1) & " gefundenen Übereinstimmungen des Suchbegriffes." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
End Sub
Irgeneine Ahnung wo das Problem liegt? Ansonsten ist alles wirklich super!
Antwort 10 von Beverly
Hi,
da kein Wert gefunden wurde, kann auch keine Zelle angefahren werden - das ist die Ursache für den Fehler. Ändere den Teil nach Next wsTabelle wie folgt
Bis später,
Karin
da kein Wert gefunden wurde, kann auch keine Zelle angefahren werden - das ist die Ursache für den Fehler. Ändere den Teil nach Next wsTabelle wie folgt
If index1 > 0 Then
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
Application.Goto Reference:=Worksheets(gefunden(1, index2)).Range(gefunden(2, index2)), _
scroll:=True
If MsgBox(gefunden(1, index2) & vbCrLf & vbCrLf & CStr(index2) & ". von " & CStr(index1) & " gefundenen Übereinstimmungen des Suchbegriffes." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
Else
MsgBox "Der Suchbegriff " & strSuche & vbCrLf & "wurde nicht gefunden", vbInformation, "Suchergebnis"
End If
Bis später,
Karin
Antwort 11 von sickboy
Ich bin schwer begeistert!!
Funktioniert! Ich hoffe mal, dass ich nicht auf noch weitere Probleme stoße!
Im Moment wüsste ich zwar nicht was das noch sein könnte...aber das kennt man ja bei solchen Sachen!
Vielen Dank nochmal!!!
Also: das nächste Eis mit Sahne! ;-)
Funktioniert! Ich hoffe mal, dass ich nicht auf noch weitere Probleme stoße!
Im Moment wüsste ich zwar nicht was das noch sein könnte...aber das kennt man ja bei solchen Sachen!
Vielen Dank nochmal!!!
Also: das nächste Eis mit Sahne! ;-)