vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Visual-Basic Einsteiger
Excel-Suchfunktion erweitern mit VBA-Code 
Autor: imebro
Datum: 29.03.22 14:40

Hallo,

ich nutze seit einiger Zeit in einer großen Excel-Liste einen VBA-Code, mit dem ich ein Suchfeld in Excel implementiert habe. Dabei wird der Suchbegriff in das Feld H2 eingetragen und dann über den Button "Suchen" danach gesucht. Als Ergebnis werden dann nur die Zeilen angezeigt, die den Suchbegriff erhalten. Die restlichen Zeilen sind ausgeblendet. Die Tabelle wird durch einen Klick auf den Button "Reset" wieder in den Ausgangszustand zurück gesetzt.

Das funktioniert recht gut.
Aber es wird hier nur in der Spalte "A" nach einem Ergebnis gesucht.

Was muss ich an dem Code ändern, damit in den Spalten A bis F gesucht wird?
Ich habe schon verschiedene Versuche unternommen... aber leider ohne Erfolg. Es musste immer debuggt werden. Z.B. hatte ich in der Code-Zeile 14 statt "A" dann einfach "A:F" eingegeben oder auch "A:A,B:B,C:C,D,E:E,F:F". Funktionierte alles nicht...

Wäre schön, wenn mir hier Jemand einen Tipp geben könnte.

Hier der bisherige Code:

Sub FilterList()
    'Variablen
    Dim rngCurrent As Range, rngHide As Range, found As Boolean
    With ActiveSheet
        .UsedRange.EntireRow.Hidden = False
        ' Wenn Suchbegriff leer blende alle Zeilen wieder ein und beende 
        ' Prozedur
        If .Range("H2").Value = "" Then
            Exit Sub
        End If
        ' Startbereich festlegen
        Set rngCurrent = .Range("A5")
        ' so lange verarbeiten bis Bereich am Ende angelangt ist
        While rngCurrent.Address <> .Cells(Rows.Count, "A").End(xlUp).Offset( _
          1, 0).Address
            ' Wenn der Suchbegriff gefunden wurde (od. ein Teil des 
            ' Suchbegriffes)
            If rngCurrent.Value Like ("*" & .Range("H2").Value & "*") Then
                found = True
                ' prüfe ob für den Bereich Untereinträge existieren
                If rngCurrent.Offset(1, 0).Value <> "" Then
                    ' verschiebe Zeile über den aktuellen Bereich hinaus damit 
                    ' er nicht ausgeblendet wird
                    Set rngCurrent = rngCurrent.End(xlDown).Offset(1, 0)
                Else
                    ' keine Untereinträge
                    Set rngCurrent = rngCurrent.Offset(1, 0)
                End If
            Else
                ' Suchbegriff in der Zeile nicht enthalten, kombiniere den 
                ' Bereich in einer Variablen
                ' um sie später auszublenden
                If Not rngHide Is Nothing Then
                    Set rngHide = Union(rngHide, rngCurrent.EntireRow)
                Else
                    Set rngHide = rngCurrent.EntireRow
                End If
                Set rngCurrent = rngCurrent.Offset(1, 0)
            End If
        Wend
        ' Wenn der Suchbegriff gefunden wurde
        If found Then
            ' blende die nicht zutreffenden Zellen aus
            If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
        Else
            MsgBox "Kein Eintrag gefunden.", vbExclamation
        End If
    End With
End Sub
Grüße,
imebro

Beitrag wurde zuletzt am 29.03.22 um 14:42:37 editiert.
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Excel-Suchfunktion erweitern mit VBA-Code209imebro29.03.22 14:40
Re: Excel-Suchfunktion erweitern mit VBA-Code80Souffleurlos29.03.22 16:28
Re: Excel-Suchfunktion erweitern mit VBA-Code55imebro30.03.22 10:05

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2022 [email protected] Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel