12
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 SubGruß
mre
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 306441
Url: https://administrator.de/contentid/306441
Ausgedruckt am: 21.11.2024 um 21:11 Uhr
12 Kommentare
Neuester Kommentar
Hi,
Zwar keine fertige Lösung, aber vielleicht ein Denkanstoss:
Warum zergliederst du deinen Suchbegriff nicht in ein Array, Trennzeichen ist das Leerzeichen, und durchsuchst deine Felder mit jedem Array-eintrag.
Das Ergebnis jedes Schleifendurchlaufs listet du dann auf.
Gruß
em-pie
Zwar keine fertige Lösung, aber vielleicht ein Denkanstoss:
Warum zergliederst du deinen Suchbegriff nicht in ein Array, Trennzeichen ist das Leerzeichen, und durchsuchst deine Felder mit jedem Array-eintrag.
Das Ergebnis jedes Schleifendurchlaufs listet du dann auf.
Gruß
em-pie
Hallo em-pi
danke für die schnelle Rückmeldung. Mit Arrays habe ich noch nicht gearbeitet.
In Access müsste mein Makro so funktionieren.
danke für die schnelle Rückmeldung. Mit Arrays habe ich noch nicht gearbeitet.
In Access müsste mein Makro so funktionieren.
Private Sub txt_Suche_AfterUpdate()
Dim i As Integer
Dim varKrit As Variant
Dim strKrit As String
strKrit = ""
If Not Trim(Me!txt_Suche) = "" Then
varKrit = Split(Trim(Me!txt_Suche), " ")
For i = 0 To UBound(varKrit)
strKrit = strKrit & " AND [BeschrKurz] Like '*" & varKrit(i) & "*'" ' [BeschrKurz] wäre in meiner Excel Tab = Spalte E
Next i
strKrit = Mid(strKrit, 5)
Me.qryArtikelUnterformular.Form.Filter = strKrit 'Filter = strKrit
Me.qryArtikelUnterformular.Form.FilterOn = True '.FilterOn = True
End If
End Sub
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
1
Hallo colinardo,
dein Demo-Sheet funktioniert ganz genau so, wie ich es mir vorgestellt hatte.
Tausend Dank dafür
mre
dein Demo-Sheet funktioniert ganz genau so, wie ich es mir vorgestellt hatte.
Private Sub btnSearch_Click()
Dim strSearchTerm As String, dic As Object, arrSearchTerms As Variant, firstAddress As String, c As Range, keys As Variant
Set dic = CreateObject("Scripting.Dictionary")
lbResults.Clear
With ActiveSheet.Range("E:E")
arrSearchTerms = Split(txtSearchTerms.Text, " ", -1, vbTextCompare)
'Suche jedes Wort
For i = 0 To UBound(arrSearchTerms)
'Suche durchführen
Set c = .Find(arrSearchTerms(i), LookIn:=xlValues, Lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If i <> 0 Then
'Es wurde schon nach dem ersten Suchwort gesucht also zähle nur 1 hinzu wenn die gefundene Zelle im Dictionary enthalten ist
If dic.Exists(c.Address) Then
dic.Item(c.Address) = dic.Item(c.Address) + 1
End If
Else
'Erstes Suchwort, also füge es zum Dictionary hinzu
dic.Add c.Address, 1
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next
'Wenn Suchergebnisse da sind ...
If dic.Count > 0 Then
' Durchlaufe alle Einträge im Dictionary und prüfe ob der Wert der Anzahl der Suchworte entspricht.
' Wenn ja, füge ihn zur Listbox hinzu
keys = dic.keys()
For i = 0 To dic.Count - 1
If dic.Item(keys(i)) = UBound(arrSearchTerms) + 1 Then
lbResults.AddItem ActiveSheet.Range(keys(i)).Value
End If
Next
Else
'Keine Suchergebnisse
MsgBox "Keine Einträge gefunden!", vbExclamation
End If
End With
End SubTausend Dank dafür
mre
Hallo Colinardo,
dein o.g. Code gibt mir jetzt die Suchergebnisse der Spalte E in der Listbox aus.
Ist es hier auch möglich, mir die anderen Spalten A, B, C, D, F, G, H auch in der Listbox anzeigen zu lassen.
Vorher hatte ich diese Spalten ausgegeben mit:
Danke
dein o.g. Code gibt mir jetzt die Suchergebnisse der Spalte E in der Listbox aus.
Ist es hier auch möglich, mir die anderen Spalten A, B, C, D, F, G, H auch in der Listbox anzeigen zu lassen.
Vorher hatte ich diese Spalten ausgegeben mit:
.ColumnCount = 7
.ColumnWidths = "2cm;2cm;2cm;5cm;2cm;2cm;2cm"
.AddItem
.List(.ListCount - 1, 0) = rngExcel.Offset(0, -3).Value 'ID
.List(.ListCount - 1, 1) = rngExcel.Offset(0, -2).Value 'ArtNr
.List(.ListCount - 1, 2) = rngExcel.Offset(0, -1).Value 'ME
.List(.ListCount - 1, 3) = rngExcel.Offset(0, -0).Value 'BeschrKurz -> Die Treffer in dieser Spalte werden ja schon ausgegeben
.List(.ListCount - 1, 4) = rngExcel.Offset(0, 1).Value 'BeschrLang
.List(.ListCount - 1, 5) = rngExcel.Offset(0, 2).Value 'KategIntern Danke
Ja kannst du, in meinem Code ist das die Zeile 34
Hier kannst du ebenfalls per Offset auf die Spalten zugreifen
Alternativ kann man die List-Eigenschaft auch mit weniger Zeilen füllen indem man mit Ranges die List-Eigenschaft füllt.
Hier kannst du ebenfalls per Offset auf die Spalten zugreifen
ActiveSheet.Range(keys(i)).Offset(0,X).Value
Alternativ kann man die List-Eigenschaft auch mit weniger Zeilen füllen indem man mit Ranges die List-Eigenschaft füllt.
Damit schreibt er mir die Ergebnisse in der Listbox untereinander und nicht nebeneinander in einer Zeile.
Was mache ich da falsch (ich kenne mich mit den Listboxen noch nicht so aus, sorry)
Was mache ich da falsch (ich kenne mich mit den Listboxen noch nicht so aus, sorry)
ActiveSheet.Range(keys(i)).Offset(0,-3).Value
ActiveSheet.Range(keys(i)).Offset(0,-2).Value
ActiveSheet.Range(keys(i)).Offset(0,-1).Value
etc.
Ja nee, ich meinte das du diese Zeile statt dem rngExcel.Offset(0, -3).Value in deinem Code verwendet hättest ...
Also, ich wollte DEINEN Code so umbauen, dass mir auch die anderen Spalten angezeigt werden.
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
Tausend Dank!! - genau das habe ich gesucht.
Vielen Dank und dir einen schönen Abend noch!
Gruß
mre
Vielen Dank und dir einen schönen Abend noch!
Gruß
mre
