AW: 0 aus Listbox entfernen
06.04.2022 21:08:54
Yal
Hallo Henry,
das Einrücken ist für die Lesbarkeit viel wichtiger als leer Zeilen dazwischen.
Und Blöcke, die thematisch nicht dazu passen (Sortierung), kann man ruhig auslagern.
Wenn Du schon deine Eingangsdaten in einem Array zwischenlagerst, dann sortiere lieber diesen Array und dann als List-Inhalt übergeben.
Auch das Löschen der Null-Einträge kann in dem Array vorgenommen werden.
Test folgende Code (da kein Beispiel-Datei vorhanden, ist der Code ungetestet. Aber die Tipp-Fehler bekommst Du hin):
Private Sub opt_Test_Click()
Dim Lrow As Long
Dim Arr
Dim i As Long
With ThisWorkbook.Sheets("Test")
Lrow = .Cells(.Rows.Count, "G").End(xlUp).Row
Arr = .Range("G4:H" & Lrow)
End With
'Nullen rausnehmen
Arr = Zero_rausnehmen(Arr)
'Bubble-Sort
Arr = Bubblesort(Arr, 1)
'Array als List reinbringen
With Me.test
.ForeColor = RGB(0, 118, 107)
.Clear
.ColumnCount = 2
.ColumnWidths = "170;60"
.List = Arr
For i = 0 To .ListCount - 1
.List(i, 1) = Right(String(10, " ") & Format(WorksheetFunction.Round(.List(i, 1), -3) / 1000, "#,###0"), 10)
Next i
End With
End Sub
Function Zero_rausnehmen(ByVal Arr)
Dim i
Dim Erg()
ReDim Erg(1, 0)
For i = 0 To UBound(Arr, 1)
If Arr(i, 0) 0 And Arr(i, 1) 0 Then
If i > 0 Then ReDim Preserve Erg(1, UBound(Arr, 2) + 1)
Erg(0, UBound(Erg, 2)) = Arr(i, 0)
Erg(1, UBound(Erg, 2)) = Arr(i, 1)
End If
Next
Zero_rausnehmen = Application.Transpose(Erg)
End Function
Function Bubblesort(ByVal Arr, SortierSpalte As Integer)
Dim i, X, j
Dim MYList As Variant
For i = LBound(Arr, 1) To UBound(Arr, 1)
For X = LBound(Arr, 1) + 1 To UBound(Arr, 1) - 1
If Val(Arr(X, SortierSpalte)) > Val(Arr(i, SortierSpalte)) Then
For j = LBound(Arr, 2) To UBound(Arr, 2)
MYList = Arr(X, j)
Arr(X, j) = Arr(i, j)
Arr(i, j) = MYList
Next j
End If
Next X
Next i
End Function
VG
Yal