Supportnet Computer
Planet of Tech

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

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.

Antwort 3 von Beverly

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

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

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

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

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

*grins*

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!

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

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! ;-)

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: