Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1192to1196
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Listbox mit mehrspaltigem Array füllen
KLE
Hallo,
ich nutze folgenden Code um eine Listbox (bisher nur eine Spalte) zu füllen, anhand eines Suchtextes.
Jetzt würde ich gern die Listbox so haben wollen, dass mir 3 Spalten angezeigt werden, wobei die Suche immernoch in der Spalte 1 stattfindet. Es soll eben nur , wenn in Spalte ein was passendes gefunden wird - auch die Spalte 2 und 3 passend dazu angezeigt werden. (Ohne Dopplungen in Spalte 1)
' Funktion zur Text-Suche

Function fncListe(Optional sText As String)
Dim oDaten As Object
i = 0
k = 0
n = 0
k = Worksheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row
Set oDaten = CreateObject("Scripting.dictionary")
If k = 1 Then
ReDim Preserve arrListe(0)
fncListe = arrListe
Exit Function
Else
arrTmp = Worksheets("Liste").Range("G5:I" & k)
ReDim arrListe(1 To UBound(arrTmp))
For i = 1 To UBound(arrTmp)
If LCase(arrTmp(i, 1)) Like "*" & LCase(sText) & "*" Then
oDaten(arrTmp(i, 1)) = 0
' ... hier müsste nun doch noch die Spalte 2 und 3 rein - aber wie ?
End If
Next
On Error Resume Next
fncListe = oDaten.keys
End If
End Function
Komme irgendwie nicht weiter, egal was ich schreibe...
Vielen Dank !
Gruß
Kay

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
vielleicht so...
16.01.2011 14:35:52
Tino
Hallo,
Du müsstest mindestens mit zwei Dictionary- Objeke arbeiten.
Müsste in etwa so funktionieren.
Function fncListe(Optional sText As String)
Dim oDaten1 As Object, oDaten2 As Object
Dim arrListe, NewArray()
Dim A As Long

    With Worksheets("Liste")
        A = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    If A = 1 Then
       fncListe = arrListe
       Exit Function
    Else
            Set oDaten1 = CreateObject("Scripting.dictionary")
            Set oDaten2 = CreateObject("Scripting.dictionary")
          
          arrListe = Worksheets("Liste").Range("G5:I" & A)
          
          For A = 1 To Ubound(arrListe)
              If InStr(LCase(arrListe(A, 1)), LCase(sText)) > 0 Then
                oDaten1(arrListe(A, 1)) = arrListe(A, 2)
                oDaten2(arrListe(A, 1)) = arrListe(A, 3)
              End If
          Next
          
          If oDaten1.Count > 0 Then
            arrListe = oDaten1.keys
            
            Redim NewArray(Ubound(arrListe), 2)
            
            For A = Lbound(arrListe) To Ubound(arrListe)
                  NewArray(A, 0) = arrListe(A)
                  NewArray(A, 1) = oDaten1(arrListe(A))
                  NewArray(A, 2) = oDaten2(arrListe(A))
            Next
            
            fncListe = NewArray
          End If
    End If
End Function
Persönlich würde ich eine Sub anstelle einer Funktion verwenden und
an diese auch die Listbox mit übergeben und diese auch in der Sub füllen,
aber vom Prinzip her auch wie diese Funktion.
Gruß Tino
Anzeige
AW: klappt, aber nicht immer ?! FC381
16.01.2011 14:58:51
KLE
Hallo Tino,
...super und vielen Dank, im Großen und Ganzen scheint es zu funktionieren.
Erhalte nur vereinzelt eine Fehlermeldung:
Fehler: 381
Eigenschaft List konnte nicht gesetzt werden. Index des Eigenschaftenfeldes ungültig.
Bei Debugg geht er in die Sub auf:
.List = fncListe(sText)
Woran kann es liegen ? Denn sie kommt nicht immer ?
' Füllen der Liste aller Daten
Private Sub DataAllFill_Suche()
Dim sText As String
sText = objTBSuche.Text
With objLBDataDefinition
.ListFillRange = ""
.List = fncListe(sText)
.ColumnCount = 3
.ColumnWidths = "300;20;50"
End With
End Sub

PS: Ich arbeite vorher mit einer Sub und übergebe nur an die Funktion. Wenn es einfacher geht ;o)
Bin ich über jeden Tip glücklich...
Gruß und Danke!
Kay
Anzeige
AW: klappt, aber nicht immer ?! FC381
16.01.2011 15:04:35
Tino
Hallo,
eventuelle wurde nichts gefunden.
Versuch es mal so.
Private Sub DataAllFill_Suche()
Dim sText As String
Dim ArrayData
sText = objTBSuche.Text
With objLBDataDefinition
.ListFillRange = ""
.ColumnCount = 3
.ColumnWidths = "300;20;50"
.Clear
ArrayData = fncListe(sText)
If IsArray(ArrayData) Then
.List = fncListe(sText)
Else
Msgbox "nix gefunden"
End If
End With
End Sub
Gruß Tino
AW: Jepp - leere Liste.
16.01.2011 23:12:43
KLE
Habe ich abgefangen und damit kommt es auch nicht mehr zu einer Fehlermeldung. Danke !!!

23 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige