Hallo Joergi,
Ich hab dir eine entsprechende Suchfunktion zusammengebaut.
Die Eingabe des jeweiligen Suchbegriffs bzgl. der Spalte erfolgt in einer Zeile oberhalb der Liste. Dazu fügst Du oberhalb deiner Telefonliste eine Zeile ein. Zur optischen Hervorhebung kannst du den Zellen dieser Zeile z.B. gelb einen gelben Hintergrund geben.
Die Spalten der Telefonliste sollten als->Text' formatiert sein.
Öffne die Telefonliste und lege mit dem VB-Editor ein Modul in dieser Mappe an. Den nachfolgenden Code kopierst Du in dieses Modul. Die Werte c_SUCHZEILE, c_SUCHSPALTE_AB, c_SUCHSPALTE_BIS, c_ERSTEWERTEZEILE mußt Du den Gegebenheiten anpassen, also
- c_SUCHZEILE -> Zeilennummer eintragen, die gelb gekennzeichnet ist
- c_SUCHSPALTE_AB -> Spaltennummer der ersten relevanten Spalte
- c_SUCHSPALTE_NIS -> Spaltennummer der letzten relevanten Spalte
- c_ERSTEWERTEZEILE -> erste Zeile mit Adressdaten
Damit hast Du das Handwerkzeug
Code:
Option Explicit
Type MySuchbegriffe_structure
s_Suchbegriff As String
l_Spalte As Long
z_cnt As Long
z() As Long
End Type
'#### A N P A S S E N ###############
->Definitionen der Suchfelder
Public Const c_SUCHZEILE = 2
Public Const c_SUCHSPALTE_AB = 1 ->entspricht Spalte A
Public Const c_SUCHSPALTE_BIS = 5->entspricht Spalte E
->erste Zeile mit Adressdaten
Public Const c_ERSTEWERTEZEILE = 4
'#### A N P A S S E N ###############
Public ws As Worksheet
'*****************************************************************
Function ZeilenMitSuchbegriffenAnzeigen( _
ws As Worksheet, _
f() As MySuchbegriffe_structure, _
f_cnt As Long)
Dim l_ZeileMax As Long, x As Long, z As Long
->erstmal alle Zeilen ausblenden
l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
ws.Rows(c_ERSTEWERTEZEILE & : & l_ZeileMax).Hidden = True
->gemerkte Zeilen mit Fundort einblenden
For x = 1 To f_cnt: For z = 1 To f(x).z_cnt: ws.Rows(f(x).z(z)).Hidden = False: Next z: Next x
End Function
'*****************************************************************
Function SuchbegriffeFeststellen( _
ws As Worksheet, _
f() As MySuchbegriffe_structure, _
f_cnt As Long)
Dim s_Suchbegriff As String, c As Long
->Alle Suchbegriffe feststellen
f_cnt = 0: ReDim f(1 To 1)
For c = c_SUCHSPALTE_AB To c_SUCHSPALTE_BIS
s_Suchbegriff = Trim(ws.Cells(c_SUCHZEILE, c).Value)
->Suchbegriff nicht leer ?
If s_Suchbegriff <> Then
->Suchbegriff und Spalte merken
f_cnt = f_cnt + 1: ReDim Preserve f(1 To f_cnt)
With f(f_cnt)
.s_Suchbegriff = s_Suchbegriff
.l_Spalte = c
->Zeilenmerker initialisieren
.z_cnt = 0: ReDim .z(1 To 1)
End With
End If
Next
End Function
'*****************************************************************
Function ZeilenMitSuchbegriffSuchen( _
ws As Worksheet, _
f() As MySuchbegriffe_structure, _
f_cnt As Long) As Boolean
Dim r As Range, Zelle As Range
Dim l_ZeileMax As Long, s_ersteAdresse As String, x As Long
Dim b_MindestensEineZeileRelevant As Boolean
b_MindestensEineZeileRelevant = False
->Zeilen mit Suchbegriff suchen
l_ZeileMax = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
->für alle Suchbegriffe
For x = 1 To f_cnt
With f(x)
Set r = ws.Range( _
ws.Cells(c_ERSTEWERTEZEILE, .l_Spalte), _
ws.Cells(l_ZeileMax, .l_Spalte))
Set Zelle = r.Find( _
What:=.s_Suchbegriff, _
After:=ws.Cells(l_ZeileMax, .l_Spalte), _
LookIn:=xlValues, _
lookat:=xlPart)
If Not Zelle Is Nothing Then
s_ersteAdresse = Zelle.Address
Do
->Zeile zum Suchbegriff merken
.z_cnt = .z_cnt + 1: ReDim Preserve .z(1 To .z_cnt)
.z(.z_cnt) = Zelle.Row
->Rückgabekennung setzen
b_MindestensEineZeileRelevant = True
->nächsten Fundort suchen
Set Zelle = r.FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> s_ersteAdresse
End If
End With
Next
Set r = Nothing: Set Zelle = Nothing
ZeilenMitSuchbegriffSuchen = b_MindestensEineZeileRelevant
End Function
Der folgende Code muß in die Code-Seite des Tabellenblattes kopiert werden.
Dort kommt man am einfachsten hin, in dem man in Excel die Blattlasche mit der rechten Maustaste anklickt und->Code anzeigen' auswählt.
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim f_Suchbegriff() As MySuchbegriffe_structure, f_Suchbegriff_cnt As Long
Dim s_Blattname As String, ws as Worksheet
s_Blattname = Target.Parent.Name
Set ws = Worksheets(s_Blattname)
->Ist etwas in der Suchzeile geändert worden ?
If Target.Rows.Count = 1 And Target.Row = c_SUCHZEILE Then
->Sind die Spalten der Suchfelder betroffen ?
If Target.Column >= c_SUCHSPALTE_AB And Target.Column <= c_SUCHSPALTE_BIS Then
->Bildschirmupdate abschalten
Application.ScreenUpdating = False
->erstmal alle Zeilen einblenden
Cells.EntireRow.Hidden = False
->vorhandene Suchbegriffe feststellen
Call SuchbegriffeFeststellen(ws, f_Suchbegriff, f_Suchbegriff_cnt)
->kein Suchbegriff vorhanden -> ENDE
If f_Suchbegriff_cnt = 0 Then GoTo AUFRAEUMEN
->Zeilen mit Suchbegriff suchen
If ZeilenMitSuchbegriffSuchen(ws, f_Suchbegriff, f_Suchbegriff_cnt) Then
->mindestens Suchbegriff in einer Zeile gefunden
->gemerkte Zeilen mit Fundort einblenden
Call ZeilenMitSuchbegriffenAnzeigen(ws, f_Suchbegriff, f_Suchbegriff_cnt)
Else
->keinen Suchbegriff in einer Zeile gefunden
->--> alle Zeilen eingeblendet lassen
End If
End If
End If
AUFRAEUMEN:
Set ws = Nothing
->Bildschirmupdate anschalten
Application.ScreenUpdating = True
End Sub
Nun kannst Du die neue Suchen-Funktion ausprobieren.
Wenn Du z.B. einen Suchbegriff->a' im gelben Feld der Spalte Namen eingibst (Eingabe mit Return abschliessen oder ander Zelle selektieren), werden alle Zeile ausgeblendet, die in der Namen-Spalte kein->a' beinhalten.
Wenn Du in einem gelben Feld einer anderen Spalte (z.B. Vorwahl) 55 eingibst, werden dir zusätzlich die Zeilen angezeigt, die in->Vorwahl' die 55 enthalten.
Willst Du die Zeilen bzgl. einem Suchbegriff wieder ausblenden, einfach den Inhalt der entsprechenden gelben Zelle löschen.
Befinden sich nur Suchbegriffe in den gelben Zellen, die in der entsprechenden Spalte nicht enthalten sind, also kein Suchbegriff zu finden, werden alle Zeilen angezeigt.
Wenn Du es besser findest, immer nur einen Suchbegriff zu verwenden, kann ich das auch noch so umbauen, daß nach der Suche die Eingabefelder für die Suchbegriffe wieder leer sind oder daß der zuletzt eingegebene Suchbegriff der massgebende ist.
Probier's mal aus.
Gruß Matjes
