Filtern von Listboxeinträgen
14.11.2013 10:48:48
Listboxeinträgen
Tino hat mir meinen Code zum einlesen von Daten in eine Listbox geholfen. Ich hatte vorher das Problem, dass er mir die Datensätze in der 3-Spaltigen Listbox nicht nebeneinander sondern untereinander eingelesen hat. Mit Tinos Code und sammeln der Daten in einem Array funktioniert das auch, Danke nochmals an Tino.
Nun ist mir aber folgender Fehler aufgefallen. Er sucht mir aus meiner Tabelle Datensätze heraus und füllt die Listbox. So bald mindestens zwei Datensätze gefunden und in die Listbox übertragen werden, werden diese auch nebeneinander angezeigt. Findet er allerdings nur einen Datensatz dann werden die Daten nicht nebeneinander sondern untereinander angezeigt.
So sollte es aussehen:
Name Vorname Geburtsdatum (geht auch so bei mindestens zwei gefundenen Sätzen)
So sieht es aus bei einem Datensatz:
Name
Vorname
Geburtsdatum
Hier der Code von Tino:
Private Sub UserForm_Activate()
'Daten aus Tabelle in Listbox einlesen
Dim I As Long, n&
Dim Dic As Object, ArValues()
Application.ScreenUpdating = False
'Listbox leer machen
Personalien.Clear
'Dictionary initialisieren
Set Dic = CreateObject("Scripting.Dictionary")
With Worksheets("Jahrestabelle")
.Activate '? wird hier nicht benötigt
I = .Range("D1000").End(xlUp).Row
If I > 4 Then
'Array groß genug Dimensionieren
ReDim Preserve ArValues(1 To 3, 1 To I - 4)
For I = 5 To I
If .Cells(I, 17).Value = "M" Then
If Not Dic.Exists(.Cells(I, 4).Value) Then
If Trim(CStr(.Cells(I, 4).Value)) "" Then
Dic(.Cells(I, 4).Value) = 0
n = n + 1 'Hilfszähler um Array zu füllen
ArValues(1, n) = .Cells(I, 4).Value
ArValues(2, n) = .Cells(I, 5).Value
ArValues(3, n) = .Cells(I, 6).Value
End If
End If
End If
Next I
'nicht benötigte Spalten entfernen
ReDim Preserve ArValues(1 To 3, 1 To n)
'Array drehen und in Listbox schreiben
Personalien.List = Application.Transpose(ArValues)
End If
End With
Application.ScreenUpdating = False
End Sub
Kann mir jemand helfen.
Gruß Werner