Suchmaschine programmieren

Sobald eine Excel-Tabelle viele Einträge hat, sind Filter beinahe unumgänglich. Man kann einzelne Begriffe selbstverständlich rasch mittels der Such-Funktion "CTRL + F" finden. Wir wollen hier jedoch in VBA unsere eigene Suchmaschine programmieren, um wiederkehrend unsere Datenbank nach einem gewünschten Suchkriterium zu durchsuchen. Unser fertiges Produkt soll somit nur diejenigen Zeilen anzeigen, welche auch dieses Kriterium enthalten. In diesem Beitrag programmieren wir eine solche Suchmaschine für folgende Musik-Datenbank:

Datenbank

Vorbereitungsschritte

Wir fügen nun oberhalb der Überschrift eine neue Zeile 1 ein. In "A1" schreiben wir "Suchkriterium:" und die Zelle "B1" markieren wir farbig - dort soll jeweils unser Suchbegriff eingegeben werden. In "C1" fügen wir ein Textfeld ein und schreiben "Suche starten!" - dies wird unser Button, um das Makro später auszulösen. Damit unser Filter auf das Suchkriterium abgestimmt werden kann, müssen wir in Spalte D die nachfolgende Formel einsetzen. Für die Zeile Nummer 3 (Zelle "D3") lautet diese für's Erste:

=WVERWEIS($B$1;A3:C3;1;FALSCH)

Du kannst nun einmal einen Suchbegriff eingeben und das Resultat für die Formel "WVERWEIS(...)" betrachten:

WVERWEIS

Ich empfehle Dir, die Suchbegriffe jeweils mit Sternchen (*) einzugeben, damit Du sicher alle Resultate angezeigt bekommst, welche den Begriff enthalten.

Die Formel "WVERWEIS(...)" müssen wir noch leicht anpassen, um den Filter besser anwenden zu können. Wir wenden hierzu zusätzlich die Formel "WENNFEHLER" und schreiben:

=WENNFEHLER(WVERWEIS($B$1;A3:C3;1;FALSCH);0)

Du siehst nun: Überall, wo vorhin "#NV" war, steht nun "0". Die Fehlermeldung "#NV" hatte uns lediglich angezeigt, dass in der entsprechenden Zeile nichts dem Suchkriterium entspricht. Die "0" wird für uns im Makro jedoch viel einfacher auszugrenzen sein.

Automatisch filtern mit VBA

Wir setzen nun den Filter auf Zeile zwei (unsere Überschrift) und beginnen, ein Makro aufzuzeichnen. Sobald der Rekorder gestartet ist, filtern wir sämtliche "0" heraus und stoppen die Aufnahme bereits wieder. Folgender Code wurde in der Zwischenzeit aufgezeichnet:

ActiveSheet.Range("$A$2:$D$8").AutoFilter Field:=4, Criteria1:="Pop"

Allerdings entspricht dies nicht ganz dem, was wir eigentlich wollten. Die Intention war es ja, alle "0" auszufiltern. Deshalb müssen wir den letzten Teil des Filterkriteriums ("Criteria1:="Pop") anpassen zu:

Criteria1:="<>0"

Wir können nun ein anderes Suchkriterium eingeben und unser Makro ausführen - es funktioniert wie gewünscht! Zuletzt können wir das Makro unserem Textfeld ("Suche starten!") zuweisen. Mittels Rechtsklick auf das Textfeld → "Makro zuweisen" kannst Du dein zuvor aufgezeichnetes Makro selektieren.

"Message-Box" über die Anzahl Treffer

Nehmen wir uns noch zwei ästhetischen Punkten an: Wir können die Spalte D problemlos ausblenden, das Makro wird nach wie vor funktionieren. Desweiteren möchten wir eine "Message-Box" einrichten, die uns jeweils die Anzahl der gefundenen Treffer angibt. Wir geben eine weitere Codezeile ein:

AnzahlTreffer = Application.WorksheetFunction.Subtotal(3, Range("A:A"))-2

Die Variable "AnzahlTreffer" umfasst das Resultat der Funktion "TEILERGEBNIS" unter der Verwendung von "ANZAHL2". Wir subtrahieren "2", um die beschriebenen Felder "A1" und "A2" abzuziehen. Nun können wir die nächste Codezeile einfügen:

MsgBox ("Insgesamt " & AnzahlTreffer & " Treffer gefunden.")

 ... und dies ist unser Resultat:

 MsgBox

6 Gedanken zu “Suchmaschine programmieren

  1. Hallo
    Habe dieses geniale Tool ausprobiert und stehe hier noch vor einem Rätsel.

    Hier meine Formel

    Option Explicit

    Sub FilterSuche()
    ActiveSheet.Range("$A$2:$D$8").AutoFilter Field:=4, Criteria1:="0"

    End Sub

    Sub Schaltfläche1_Klicken()
    Dim anzahltreffer As String
    anzahltreffer = Application.WorksheetFunction.Subtotal(3, Range("A:A")) - 2
    MsgBox ("Insgesamt " & anzahltreffer & " Treffer gefunden.")
    End Sub

    Was muss ich tun, damit das Makro automatisch läuft? Wieso kommt beim Löschen der Suche nicht wieder alle Resultate?

    Ich bin leider kein Held in VBA 🙁 Hoffe ihr könnt mir helfen.

    Vielen Dank.

    Freundliche Grüsse

    Kevin

    • Hallo Kevin

      Mir ist aufgefallen, dass Du beim Filter Criteria1:="0" hast. Da müsstest Du Criteria1:="<>0" -- also ungleich 0 haben. Ansonsten zeigt Dir der Filter alle Resultate, welche eben nicht auf Dein Suchkriterium zutreffen.

      Um nach der Suche alle Werte anzuzeigen, kannst Du entweder:
      1) Manuell den Filter zurücksetzen (auch via Tastenkombination Alt --> A --> C)
      2) Als Suchkriterium nur einen Stern (*) eingeben und erneut suchen - dieser Platzhalter trifft auf alle Einträge in Deiner Liste zu.

      Hast Du absichtlich zwei Makros (FilterSuche sowie Schlatfläche1_Klicken) erstellt? Wenn Du nur einmal zu Beginn "Sub FilterSuche()" und am Ende des gesamten Codes "End Sub" verwendest, führt Deine Suchmaschine die Suche durch und gibt auch gleich via Textbox die Anzahl Treffer an.

      Beste Grüsse & viel Erfolg
      Roman

  2. Hallo Roman

    Es wäre sehr hilfreich, wenn du den ganzen Code auflisten könntest. Ich stehe bei der Msg Box an.
    Hier mal mein Code:

    Option Explicit

    Sub Makro2()
    ActiveSheet.Range("$A$2:$D$8").AutoFilter Field:=4, Criteria1:="0"

    End Sub

    Da stecke ich leider fest. Hoffe du kannst mir mit dem kompletten Makro weiterhelfen.

    Vielen Dank.

    Und wo gehört nun der fehlende Rest hin?

    • Hallo Kevin

      Dies ist der komplette Code, einfach alles kopieren und in Dein Modul einfügen:

      Sub FilterSuche()

      ActiveSheet.Range("$A$2:$D$8").AutoFilter Field:=4, Criteria1:="<>0"

      Dim anzahltreffer As String
      anzahltreffer = Application.WorksheetFunction.Subtotal(3, Range("A:A")) - 2
      MsgBox ("Insgesamt " & anzahltreffer & " Treffer gefunden.")

      End Sub

      Hat's geklappt? 🙂

      Beste Grüsse
      Roman

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.