- #1
C
Christian Gebbe
Guest
Hallo liebe Community,
ich habe die Seite über die googlesuche gefunden, da ich eine Liste mit Suchfeld in Excel kreiren möchte. Dabei bin ich auf diese Seite gestoßen:
http://www.wintotal-forum.de/index....f7fc89c915e0657a91f7905&topic=91493.0;all
Das Skript klappt ganz wunderbar, allerdings liefert es bei mehreren Suchbegriffen mehr anstatt weniger Ergebnisse (also additive statt subtraktive Suche). Ich bin selber kein Excel Programmierer, habe mir aber den Code angeguckt und verstanden wieso.
Kann man dass Skript so umschreiben, dass es bei mehreren Suchbegriffen die Suche eingrenzt? Theoretisch wären meine Ideen gewesen, dass entweder die gefundenen Reihen so oft gefunden werden müssen wie es Suchbegriffe gibt;
oder dass man nicht die Zellen findet, die den Suchbegriff enthalten, sondern die, die den Suchbegriff NICHT enthalten, und bei der Ergebnisdarstellung dann erst alle einblendet und anschließend die gefunden Reihen ausblendet. Ich habe auch probiert dies umzusetzen, bin aber einfach zu wenig mit Excel vertraut.
Ich hoffe ihr könnt mir helfen, hier nochmal der Code von Matjes (ich hoffe du guckst hier rein) und schon ein mal vielen Dank im voraus!
Christian
ich habe die Seite über die googlesuche gefunden, da ich eine Liste mit Suchfeld in Excel kreiren möchte. Dabei bin ich auf diese Seite gestoßen:
http://www.wintotal-forum.de/index....f7fc89c915e0657a91f7905&topic=91493.0;all
Das Skript klappt ganz wunderbar, allerdings liefert es bei mehreren Suchbegriffen mehr anstatt weniger Ergebnisse (also additive statt subtraktive Suche). Ich bin selber kein Excel Programmierer, habe mir aber den Code angeguckt und verstanden wieso.
Kann man dass Skript so umschreiben, dass es bei mehreren Suchbegriffen die Suche eingrenzt? Theoretisch wären meine Ideen gewesen, dass entweder die gefundenen Reihen so oft gefunden werden müssen wie es Suchbegriffe gibt;
oder dass man nicht die Zellen findet, die den Suchbegriff enthalten, sondern die, die den Suchbegriff NICHT enthalten, und bei der Ergebnisdarstellung dann erst alle einblendet und anschließend die gefunden Reihen ausblendet. Ich habe auch probiert dies umzusetzen, bin aber einfach zu wenig mit Excel vertraut.
Ich hoffe ihr könnt mir helfen, hier nochmal der Code von Matjes (ich hoffe du guckst hier rein) und schon ein mal vielen Dank im voraus!
Christian
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
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
