Beiträge zum Thread: Gefiltertes Array in Listbox einlesen

Hallo

Du solltest bei deinem ReDIM auch die Variable "treffer" verwenden.

Mfg.
Peter

Hi
das stecken zwei Fehler drin.
ein Logikfehler und ein Wissensfehler

der Logikfehler ist, dass du beim Redimensionieren des Arrays die Werte nicht änderst.
hier setzt du die Anzahl der Zeilen nicht neu, sondern wieder auf den ursprünglichen Wert.
falsch:

ReDim Preserve arrFilter(1 To UBound(arrFilter, 1), 1 To UBound(arrQuell, 2))

richtigerweise müsstest du auf die Anzahl der gefilterten Werte redimensionieren und diese zählst du ja in der Variablen Treffer, dahrer
richtig:

ReDim Preserve arrFilter(1 To Treffer, 1 To UBound(arrQuell, 2))

hier würde jetzt aber der Wissensfehler zuschlagen, denn du darfst mit Redim-Preserve immer nur letzte Dimension verändern, die anderen Dimensionen müssen gleich bleiben.
dh in deinem 2-d-Array kannst du nur die Spaltenanzahl verändern, aber nicht die Zeilenzahl.

dh das Anpassen auf die Zeilenzahl könnte dann so aussehen:

ArrFilter = Worksheetfunction.Transpose(ArrFilter)

Redim Preserve ArrFilter(1 to Ubound(arrFilter 1), 1 to Treffer)

ArrFilter = Worksheetfunction.Transpose(ArrFilter)

oder du legst nach der Ermittlung der Daten ein neues Array mit den richtigen Dimensionen an und schaufelst dann die Daten per Schleife rüber.

am elegantesten wäre wahrscheinlich, wenn du die Anzahl der benötigten Zeilen vorab ermittels und ArrFilter gleich auf den richtigen Wert dimensionierst.
das ginge hier am einfachsten mit ZählenWenns (Worksheetfunction.Countif)

Redim arrFilter(1 to Worksheetfunction.Countif(WS.Columns(1), krit1, ws.Columns(4), krit2), 1 to Ubound(arrQuelle, 2))

Gruß Daniel

Hallo Daniel,

danke für die Rückmeldung.

Bei

ReDim Preserve arrFilter(1 To Treffer, 1 To UBound(arrQuell, 2)) 

erhalte ich "Außerhalb des gültigen Bereichs" und bei

Redim arrFilter(1 to Worksheetfunction.Countif(WS.Columns(1), krit1, ws.Columns(4), krit2), 1 to Ubound(arrQuelle, 2))

falsche Anzahl an Argumenten...

Schaue später nochmal rein.

Gruß
Chris

hi

zum einen hast du dich jetzt geoutet, dass du meinen Beitrag nicht wirklich gelesen hast.
Denn ich hatte ja geschrieben, dass wenn du das machst, was du hier zeigst, der zweite Fehler zuschlägt, nämlich dass du die erste Dimension gar nicht verändern darfst sondern nur die zweite.
Also bitte alles aufmerksam lesen und nicht einfach nur das erstebeste kopieren und einfügen.

beim zweiten will ich nicht ausschließen , dass da ein Klammer- oder Tippfehler drin ist.
jetzt beim drüberschauen fällt mir auf, dass da das "s" fehlt, da du hier zwei Kriteren hast, muss es natürlich "CountIfs" heißen und nicht nur "CountIf"

Gruß Daniel

Hi,

...für mich ist das gar keine eigenständige Excelversion...?!

VG, Boris

.......

Hallo Chris,

auf die Schnelle und ungetestet so:

Sub FillListbox1()

    Dim arrTab(), arrList(), i&, j&, k&, lz&, krit1$, krit2$

    With Sheets("Rohdaten")

        krit1 = Label1380.Caption

        krit2 = Label450.Caption

        lz = .Cells(.Rows.Count, "A").End(xlUp).Row

        arrTab = .Range("A2:U" & lz).Value

    End With

    ReDim arrList(1 To 3, 1 To UBound(arrTab))

    For i = 1 To UBound(arrTab, 1)

        If arrTab(i, 1) = krit1 And arrTab(i, 4) = krit2 Then

            k = k + 1

            arrList(1, k) = arrTab(i, 7)

            arrList(2, k) = arrTab(i, 8)

            arrList(3, k) = arrTab(i, 21)

        End If

    Next i

    ReDim Preserve arrList(1 To 3, 1 To k)

    With ListBox1

        .ColumnCount = 3

        .ColumnWidths = "100;150;30"

        .Column = arrList

    End With

End Sub

Das Ausgabe-Array musst du mit vertauschten Dimensionen füllen, damit du mit Redim Preserve arbeiten kannst. Redim Preserve kann nur die letzte Dimension ändern.
In Folge dessen musst du die Listbox via .Column mit dem Ausgabe-Array füllen.

Gruß Uwe

Hallo Uwe,

etwas verspätet: Danke! Das funktioniert prima.

Bevor das gefilterte Array in der Lisbox ausgegeben wird, möchte ich das Array alphabetisch aufsteigend sortieren (Spalte A bzw. arrList(2,k).

Wie macht man das in einem Array? ...oder ist es besser, dies mit den Rohdaten im Sheet vorab zu machen?

LG
Chris

Hi
VBA hat jetzt noch keine Sortierfunktion für Arrays.
Es gibt zwar die SortedArrayList, welches Ein Array mit sortierten Werten ist, aber die kenne ich jetzt nicht genug.

Wenn es möglich ist, wäre das einfachste, die Quelldaten mit der Sortierfunktion von Excel vorab zu sortieren.
du kannst auch das fertige Array in einen freien Zellbereich rausschreiben, dort sortieren und dann wieder einlesen.

bei einer Listbox gäbe es noch die Möglichkeit, die Listbox mit .AddItem zu befüllen (sofern die gegebenheiten das zuslassen)
bei .AddItem kann man den neuen Wert nicht nur am Ende einfügen, sondern auch irgendwo zwischen drin:

Listbox1.AddItem "NeuerWert, 2

dh wenn du eine Listbox sortiert befüllen willst, dann gehst du einfach mit einer Schleife durch die vorhandenen Listboxwerte und prüfst, bei welcher Zeile Listbox wert größer wird als der vorhandene Wert aus dem Array und fügst dann an dieser Stelle ein.

Gruß Daniel

nochmal mit Code:

mit folgendem Beispielcode erzeugt man aus einem unsortierten Array "arr" eine sortierte Listbox:
hier für 3 Spalten

ListBox1.Clear

For a = 1 To UBound(arr, 1)

    For L = 0 To ListBox1.ListCount - 1

        If arr(a, 1) < ListBox1.List(L, 0) Then Exit For

    Next

    ListBox1.AddItem arr(a, 1), L

    ListBox1.List(L, 1) = arr(a, 2)

    ListBox1.List(L, 2) = arr(a, 3)

Next

mit den Datenmengen, die in einer Listbox üblich sind, braucht man keine Superschnelle Sortiermethode.
das funkioniert, solange die Listbox mit AddItem befüllt werden kann, dh solange sie nicht mehr als 10 Spalten hat.
an gleicher Stelle könnte man auch Duplikate vermeiden, falls das erforderlich ist.
Gruß Daniel

Hallo,

der einfachste Weg bei älteren Excel ist, dies mit Quicksort zu machen.

Private Sub QuickSort(lngLBound As Long, lngUBound As Long, avntArray As Variant, lngSortColumn As Long)

    Dim lngIndex1 As Long, lngIndex2 As Long, lngColumn As Long

    Dim vntBuffer As Variant, vntTemp As Variant

    lngIndex1 = lngLBound

    lngIndex2 = lngUBound

    vntTemp = avntArray((lngLBound + lngUBound) \ 2, lngSortColumn)

    Do

        Do While avntArray(lngIndex1, lngSortColumn) < vntTemp

            lngIndex1 = lngIndex1 + 1

        Loop

        Do While vntTemp < avntArray(lngIndex2, lngSortColumn)

            lngIndex2 = lngIndex2 - 1

        Loop

        If lngIndex1 <= lngIndex2 Then

            For lngColumn = LBound(avntArray, 2) To UBound(avntArray, 2)

                vntBuffer = avntArray(lngIndex1, lngColumn)

                avntArray(lngIndex1, lngColumn) = avntArray(lngIndex2, lngColumn)

                avntArray(lngIndex2, lngColumn) = vntBuffer

            Next

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        End If

    Loop Until lngIndex1 > lngIndex2

    If lngLBound < lngIndex2 Then Call QuickSort(lngLBound, lngIndex2, avntArray, lngSortColumn)

    If lngIndex1 < lngUBound Then Call QuickSort(lngIndex1, lngUBound, avntArray, lngSortColumn)

End Sub

und

Sub FillListbox1()

    Dim arrTab(), arrList(), i&, j&, k&, lz&, krit1$, krit2$

    With Sheets("Rohdaten")

        krit1 = 2025

        krit2 = 50

        lz = .Cells(.Rows.Count, "A").End(xlUp).Row

        arrTab = .Range("A2:U" & lz).Value

    End With

    ReDim arrList(1 To 3, 1 To UBound(arrTab))

    For i = 1 To UBound(arrTab, 1)

        If arrTab(i, 1) = krit1 And arrTab(i, 4) = krit2 Then

            k = k + 1

            arrList(1, k) = arrTab(i, 7)

            arrList(2, k) = arrTab(i, 8)

            arrList(3, k) = arrTab(i, 21)

        End If

    Next i

    ReDim Preserve arrList(1 To 3, 1 To k)

    With ListBox1

        .ColumnCount = 3

        .ColumnWidths = "100;150;30"

        .Column = arrList

        arrList = .List

        Call QuickSort(LBound(arrList), UBound(arrList), arrList, 2)

        .List = arrList

    End With

End Sub

Gruß Uwe

Oder so:

Sub M_snb()

  With Sheets("Rohdaten").Cells(1).CurrentRegion

    .AutoFilter 1, Label1380.Caption

    .AutoFilter 4, Label450.Caption

    .Copy .Parent.Cells(1, 60)

    Listbox1.List = .Parent.Cells(1, 60).CurrentRegion

    .Parent.Cells(1, 60).CurrentRegion.ClearContents

  End With

    

  With Listbox1

    .ColumnCount = 21

    .ColumnWidths = "0;0;0;0;0;0100;150;0;0;0;0;0;0;0;0;0;0;0;0;30"

  End With

End Sub

kleines Fehler (.value) verbessert und vereinfacht:

Sub M_snb()

  With Sheets("rohdaten").Cells(1).CurrentRegion

    .AutoFilter 1, Label1380

    .AutoFilter 4, Label450

    .Copy .Parent.Cells(1, 60)

    ListBox1.List = Application.Index(.Parent.Cells(1, 60).CurrentRegion.Value, [row(1:100)], Array(7, 8, 21))

    .Parent.Cells(1, 60).CurrentRegion.ClearContents

  End With

    

  ListBox1.ColumnCount = 3

End Sub