Forumbeitrag
Excel-Version des Fragestellers:
2016
Erfahrungslevel des Fragestellers:
Excel-Profi - VBA gut
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