mreske
Goto Top

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?

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

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

em-pie
em-pie 07.06.2016 um 23:54:19 Uhr
Goto Top
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
mreske
mreske 08.06.2016 um 06:23:52 Uhr
Goto Top
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.

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
129413
129413 08.06.2016 um 07:40:34 Uhr
Goto Top
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
colinardo
Lösung colinardo 08.06.2016 aktualisiert um 10:06:45 Uhr
Goto Top
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
mreske
mreske 08.06.2016 um 18:27:15 Uhr
Goto Top
Hallo colinardo,
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 Sub

Tausend Dank dafür
mre
mreske
mreske 08.06.2016 aktualisiert um 19:23:47 Uhr
Goto Top
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:

.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
colinardo
colinardo 08.06.2016 aktualisiert um 19:44:52 Uhr
Goto Top
Ja kannst du, in meinem Code ist das die Zeile 34
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.
mreske
mreske 08.06.2016 um 19:48:08 Uhr
Goto Top
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)

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.
colinardo
colinardo 08.06.2016 aktualisiert um 19:53:53 Uhr
Goto Top
Ja nee, ich meinte das du diese Zeile statt dem rngExcel.Offset(0, -3).Value in deinem Code verwendet hättest ...
mreske
mreske 08.06.2016 um 20:23:36 Uhr
Goto Top
Also, ich wollte DEINEN Code so umbauen, dass mir auch die anderen Spalten angezeigt werden.

2016-06-08_201817
colinardo
Lösung colinardo 08.06.2016 aktualisiert um 20:38:21 Uhr
Goto Top
Logisch, na dann muss ich es wohl wieder vorbeten ...
multiwort_artikelsuche_2_306441.xlsm

Grüße und schönen Abend
Uwe
mreske
mreske 08.06.2016 um 20:36:58 Uhr
Goto Top
Tausend Dank!! - genau das habe ich gesucht.

Vielen Dank und dir einen schönen Abend noch!
Gruß
mre