Diskussionsgruppe: Tabellenkalkulation
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!!)
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
Von: sickboy Datum: 23.05.2007, 09:01
Antwort 1
von Beverly vom 23.05.2007, 09:28
Hi,
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 vom 23.05.2007, 09:59
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.
Antwort 3
von Beverly vom 23.05.2007, 13:17
Hi,
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 vom 23.05.2007, 16:11
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:
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 vom 23.05.2007, 17:59
Hi,
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 vom 24.05.2007, 08:18
SUPER!!!
Perfekt! Genauso wie ich es brauche! Ich bin schwer begeistert!!
Fühl Dich virtuell zu nem Kaffee o.ä. eingeladen!!
DANKE!!!!
Antwort 7
von Beverly vom 24.05.2007, 09:02
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
Antwort 8
von sickboy vom 24.05.2007, 11:30
*grins*
Auch dazu bist Du natürlich herzlich eingeladen!
Antwort 9
von sickboy vom 25.05.2007, 07:50
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!
|
|
