| |
Visual-Basic EinsteigerExcel-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. | |
Re: Excel-Suchfunktion erweitern mit VBA-Code | | | Autor: Souffleurlos | Datum: 29.03.22 16:28 |
| Hi,
nimm das Selection-Object.
Dim r As Excel.Range
Workbook.Sheets("Tabelle_1).Eange("A:F").Select
For Each r In Application.Selection
...
Next
Das sucht in Spalte A,B,C,D,E,F ...
CurrwentRange ist gefährlich. | |
Re: Excel-Suchfunktion erweitern mit VBA-Code | | | Autor: imebro | Datum: 30.03.22 10:05 |
| Hallo und danke für die Antwort.
Ich habe noch ein paar Fragen:
1) Wo genau muss ich das denn in meinem Code einsetzen?
Bzw... was muss ich in meinem Code löschen?
2) wieso ist CurrentRange gefährlich?
3) Ebenso würde mich interessieren, ob dann der Effekt noch funktioniert, dass mir nach der Suche NUR die Ergebnisse angezeigt werden, so wie es ja jetzt ist?
4) Gibt es denn im jetzigen Code nicht auch eine Möglichkeit, einfach von A bis F zu suchen, statt nur in Spalte A?
Grüße,
imebro | |
| 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 |
|
|
vb@rchiv CD Vol.6 vb@rchiv Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion Entwickler-Vollversionen u.v.m.Jetzt zugreifen Tipp des Monats TOP! Unser Nr. 1
Neu! sevDataGrid 3.0
Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Weitere Infos
|
|
|
Copyright ©2000-2024 vb@rchiv 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
|
|