Spalte E nach beliebig vielen Suchbegriffen (mit Leerzeichen getrennt) durchsuchen und in Listbox ausgeben
Hallo
ich habe eine Excel Tabelle mit einem Artikelstamm, in dem in der Spalte E die ARTIKELBEZEICHNUNG steht.
Ich möchte diese Spalte nach mehreren Suchkriterien (durch Leerzeichen getrennt) durchsuchen.
Der Suchbegriff könnte z.B lauten:
Jacke oran xxl Kapu
Die Eingabe der Suchbegriffe erfolgt über die Textbox: txt_Suche
Die Treffer sollen in der Listbox ausgegeben werden: dblst_Treffer
Ausgegeben in der Listbox werden soll dann:
Winterjacke gefüttert orange XXL mit knöpfbarer Kapuze
Sommerjacke XXL orange gelb mit angenähter Kapuze
Nach nur einem Suchbegriff kann ich mit unten angegebenem Makro suchen.
Ich möchte jedoch, wie oben beschrieben, nach mehreren Suchbegriffen suchen.
Hat hier jemand eine Idee, wie man das Makro unten umbauen müsste?
Gruß
mre
ich habe eine Excel Tabelle mit einem Artikelstamm, in dem in der Spalte E die ARTIKELBEZEICHNUNG steht.
Ich möchte diese Spalte nach mehreren Suchkriterien (durch Leerzeichen getrennt) durchsuchen.
Der Suchbegriff könnte z.B lauten:
Jacke oran xxl Kapu
Die Eingabe der Suchbegriffe erfolgt über die Textbox: txt_Suche
Die Treffer sollen in der Listbox ausgegeben werden: dblst_Treffer
Ausgegeben in der Listbox werden soll dann:
Winterjacke gefüttert orange XXL mit knöpfbarer Kapuze
Sommerjacke XXL orange gelb mit angenähter Kapuze
Nach nur einem Suchbegriff kann ich mit unten angegebenem Makro suchen.
Ich möchte jedoch, wie oben beschrieben, nach mehreren Suchbegriffen suchen.
Hat hier jemand eine Idee, wie man das Makro unten umbauen müsste?
Private Sub txt_Suche_AfterUpdate()
Dim wbkExcel As Excel.Workbook
Dim wksExcel As Excel.Worksheet
Dim rngExcel As Excel.Range
Dim rngCell As Range
Dim strFirstAddress As String
Dim Suchwort As String
Set appExcel = Excel.Application
Set wbkExcel = Excel.Workbooks.Open("C:\tbl_ArtStamm.xlsx", ReadOnly:=True)
Set wksExcel = Excel.Worksheets("ArtStamm")
Set rngExcel = wksExcel.UsedRange
Suchwort = ("*" & Me.txt_Suche.Value & "*") ' hier möchte ich aber beliebig viele Suchbegriffe (mit Leerzeichen getrennt eingeben)
With wksExcel.Range("E:E")
Me.dblst_Treffer.Clear
Set rngExcel = .Find(Suchwort, LookIn:=xlValues, lookat:=xlWhole)
If Not rngExcel Is Nothing Then
strFirstAddress = rngExcel.Address
Do
With Me.dblst_Treffer
.ColumnCount = 1
AddItem
.List(.ListCount - 1, 4) = rngExcel.Text
.ColumnWidths = "5cm"
End With
Set rngExcel = .FindNext(rngExcel)
Loop While Not rngExcel Is Nothing And rngExcel.Address <> strFirstAddress
Else
End If
End With
wbkExcel.Close
End Sub
Gruß
mre
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 306441
Url: https://administrator.de/forum/spalte-e-nach-beliebig-vielen-suchbegriffen-mit-leerzeichen-getrennt-durchsuchen-und-in-listbox-ausgeben-306441.html
Ausgedruckt am: 22.12.2024 um 13:12 Uhr
12 Kommentare
Neuester Kommentar
Ich würde das mit einem Dictionary-Object machen in dem ich die Suchbegriffe erst per Split und dem Leerzeichen auftrenne und dann per Schleife jeden Suchbegriff in die Suche injiziere und dann bei Erfolg den Namen der Zelle in das Dictionary eintrage. Kommt dann eine Zelle die schon im Dictionary steht zähle ich zum Wert der Zelle im Dictionary 1 hinzu. Zum Schluss durchlaufe ich das Dictionary und prüfe ob der Wert dem UBound() des Splits entspricht, wenn das der Fall ist (d.h. also das alle Begriffe in der Zelle vorkommen) übernehme ich den Zellwert in die Listbox ansonsten nicht.
Gruß Skybird
Gruß Skybird
Hallo mre,
so wie deine Beschreibung formuliert ist, gehe ich einfach mal davon aus das alle deine Suchwörter in einem Artikel vorhanden sein müssen den du suchst. In dem Fall schau dir das Demo-Sheet dazu an:
multiwort_artikelsuche_306441.xlsm
Grüße Uwe
so wie deine Beschreibung formuliert ist, gehe ich einfach mal davon aus das alle deine Suchwörter in einem Artikel vorhanden sein müssen den du suchst. In dem Fall schau dir das Demo-Sheet dazu an:
multiwort_artikelsuche_306441.xlsm
Grüße Uwe
Logisch, na dann muss ich es wohl wieder vorbeten ...
multiwort_artikelsuche_2_306441.xlsm
Grüße und schönen Abend
Uwe
multiwort_artikelsuche_2_306441.xlsm
Grüße und schönen Abend
Uwe