Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Mehrspaltige Listbox filtern

Betrifft: Mehrspaltige Listbox filtern von: Linus
Geschrieben am: 30.09.2014 09:38:39

Hallo zusammen,

leider habe ich auf meinen letzten Beitrag noch keine Antwort bekommen. Daher versuche ich es erneut.

Wie kann ich eine Listbox anhand einer Eingabe, z.B. in eine Textbox filtern??

So sieht meine zu filternde Liste aus:

Straße	           Ort	         Ortsteil    PLZ	Zusatz	    Tour  Altern. Komm.
Aachener Straße	   Saarbrücken   Burbach     66115	Hochstraße  S07	  	
Abstäberhof	   Kirkel	 Neuhäusel   66459	 	    S13		
Abteistraße	   Tholey	 Tholey	     66636	 	    B02		
Abteistraße	   Merzig	 Besseringe  66663	 	    B16		
Abteistraße	   Wadgassen     Wadgassen   66787	 	    B23		
Abt-Fulrad-Str	   Kleinblittersdorf	     66271	 	    S11	  S13	
.
.
.

Sie umfasst ca. 15.000 Zeilen.

Ich habe bisher für jede Spalte eine Textbox eingefügt. Also für die Suche einer Straße, füe die Suche eines Ortes, usw.

Die Listbox erzeuge ich über folgenden Code:

  • 
    
    Private Sub Userform_initialize()
    
    
                            Dim loletzteX As Long
                            loletzteX = Sheets("Touren").Cells(Rows.Count,1).End(xlUp).Row
                            
                            With ListBox1
                              .ColumnCount = 8
                              .ColumnWidths = "5cm;5cm;4cm;2cm;3cm;1,5cm;2cm;3cm;"
                              .ColumnHeads = True
                              ListBox1.RowSource = "Touren!B2:I" & loletzteX
                            End With
                            
                           ListBox1.ListIndex = ListBox1.ListCount - 1
                        
                       End Sub



  • Ich hoffe es kann mir geholfen werden. Danke bereits im Voraus.

      

    Betrifft: AW: Mehrspaltige Listbox filtern von: Martin
    Geschrieben am: 30.09.2014 09:50:02

    Hallo Linus,

    soll eine Art Volltextsuche durchgeführt werden (...also sollen alle 8 Spalten durchsucht werden)?

    Viele Grüße

    Martin


      

    Betrifft: AW: Mehrspaltige Listbox filtern von: Martin
    Geschrieben am: 30.09.2014 10:04:43

    Hallo Linus,

    ich habe jetzt eine Volltextsuche programmiert. Die Groß-/Kleinschreibung wird berücksichtigt
    Der Suchbegriff ist in TextBox1 einzutragen. Bei 15 Zeilen kann die Suche evtl. langsam sein, musst du mal austesten:

    Private Sub TextBox1_Change()
    
        Dim arrData As Variant, arrData2 As Variant
        Dim iLastRow As Integer
        
        With Worksheets("Touren")
            iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            arrData = .Range(.Cells(2, 2), .Cells(iLastRow, 9)).Value
        End With
        
        If Not Trim(TextBox1) = Empty Then
            arrData2 = filter2dArray(arrData, "*" & TextBox1.Text & "*")
        End If
        
        If VarType(arrData2) = Empty Then
            ListBox1.Clear
        Else
            ListBox1.List() = arrData2
        End If
    End Sub
    
    Function filter2dArray(sourceArr As Variant, matchStr As String) As Variant
        Dim matchArrIndex As Variant, splitArr As Variant
        Dim i As Integer, outerindex As Integer, innerIndex As Integer, tempArrayIndex As Integer,  _
    CurrIndex As Integer, stringLength As Integer, matchType As Integer
        Dim increaseIndex As Boolean
        Dim actualStr As String
        
        splitArr = Split(matchStr, "*")
        
        On Error GoTo errorHandler
        
        If UBound(splitArr) = 0 Then
            matchType = 0 'Exact Match
            actualStr = matchStr
        ElseIf UBound(splitArr) = 1 And splitArr(1) = "" Then
            matchType = 1 'Starts With
            actualStr = splitArr(0)
        ElseIf UBound(splitArr) = 1 And splitArr(0) = "" Then
            matchType = 2 'ends With
            actualStr = splitArr(1)
        ElseIf UBound(splitArr) = 2 And splitArr(0) = "" And splitArr(2) = "" Then
            matchType = 3 'contains
            actualStr = splitArr(1)
        Else
            MsgBox "Incorrect match provided"
            Exit Function
        End If
        'start index
        i = LBound(sourceArr, 1)
        'resize array for matched values
        ReDim matchArrIndex(LBound(sourceArr, 1) To UBound(sourceArr, 1)) As Variant
        'outer loop
        For outerindex = LBound(sourceArr, 1) To UBound(sourceArr, 1)
        'inner loop
            For innerIndex = LBound(sourceArr, 2) To UBound(sourceArr, 2)
                'if string matches with array elements
                
                If (matchType = 0 And sourceArr(outerindex, innerIndex) = actualStr) Or _
                    (matchType = 1 And Left(sourceArr(outerindex, innerIndex), Len(actualStr)) =  _
    actualStr) Or _
                    (matchType = 2 And Right(sourceArr(outerindex, innerIndex), Len(actualStr)) =  _
    actualStr) Or _
                    (matchType = 3 And InStr(sourceArr(outerindex, innerIndex), actualStr) <> 0)  _
    Then
                    increaseIndex = True
                    matchArrIndex(i) = outerindex
                End If
                
            Next
            
            If increaseIndex Then
                tempArrayIndex = tempArrayIndex + 1
                increaseIndex = False
                i = i + 1
            End If
        Next
        'if no matches found, exit the function
        If tempArrayIndex = 0 Then
            Exit Function
        End If
        If LBound(sourceArr, 1) = 0 Then
            tempArrayIndex = tempArrayIndex - 1
        End If
        'resize temp array
        ReDim tempArray(LBound(sourceArr, 1) To tempArrayIndex, LBound(sourceArr, 2) To UBound( _
    sourceArr, 2)) As Variant
        CurrIndex = LBound(sourceArr, 1)
        Dim j As Integer
        j = LBound(matchArrIndex)
        'store values in temp array
        For i = CurrIndex To UBound(tempArray)
            For innerIndex = LBound(sourceArr, 2) To UBound(sourceArr, 2)
                tempArray(i, innerIndex) = sourceArr(matchArrIndex(j), innerIndex)
            Next
            j = j + 1
        Next
        filter2dArray = tempArray
        Exit Function
    errorHandler:
        MsgBox "Error :" & Err.Description
    End Function
    



      

    Betrifft: AW: Mehrspaltige Listbox filtern von: Linus
    Geschrieben am: 30.09.2014 10:15:35

    Hi Martin,

    erstmal danke für die schnelle Antwort. Ich werde es direkt mal testen und dir dann das Ergebnis durchgeben :-)


      

    Betrifft: AW: Mehrspaltige Listbox filtern von: Linus
    Geschrieben am: 30.09.2014 10:23:00

    Hallo Martin,

    also beim Testen bringt er mir folgende Fehlermeldung: "Zugriff verweigert" und markiert folgende Codestelle: ListBox1.List() = arrData2


      

    Betrifft: AW: Mehrspaltige Listbox filtern von: Martin
    Geschrieben am: 30.09.2014 10:33:13

    Hallo Linus,

    ich vermute (und hoffe), dass es nur an deiner RowSource-Zuweisung liegt. Tausche mal bitte dein Initialize-Makro aus:

    Private Sub Userform_initialize()
        
        Dim arrData As Variant, iLastRow As Integer
        
        With Worksheets("Touren")
            iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            arrData = .Range(.Cells(2, 2), .Cells(iLastRow, 9)).Value
        End With
            
        With ListBox1
            .ColumnCount = 8
            .ColumnWidths = "5cm;5cm;4cm;2cm;3cm;1,5cm;2cm;3cm;"
            .ColumnHeads = True
            .List() = arrData
            .ListIndex = .ListCount - 1
        End With
     
    End Sub
    Viele Grüße

    Martin


      

    Betrifft: AW: Mehrspaltige Listbox filtern von: Peter Feustel
    Geschrieben am: 30.09.2014 11:14:31

    Hallo Linus,

    mit Auswahl der Such-Spalte und Verlassen der TextBox sollte die ListBox gefiltert werden.
    Mit Klick auf einen gefilterten ListBox-Eintrag sollte der in der Tabelle markiert werden.

    Gruß Peter

    https://www.herber.de/bbs/user/92902.xlsm


      

    Betrifft: AW: Mehrspaltige Listbox filtern von: Linus
    Geschrieben am: 30.09.2014 11:30:49

    Hallo Peter,

    so geht es auch!!! :-) Perfekt!! Vielen Herzlichen Dank an euch beide für eure schnelle Hilfe!!

    Mit besten Grüßen

    Linus


     

    Beiträge aus den Excel-Beispielen zum Thema "Mehrspaltige Listbox filtern"