Problem mit Listbox
30.07.2017 12:53:43
Peter
ich habe ein Problem mit einer ListBox.
Mittels der Listbox wird der jeweilige Eintrag ausgewählt. Die Daten werden in die
Textboxes eingetragen. Mittels CombiBox wird dann Wert in einer TextBox geändert und
mittels Button wird der Wert in die Tabelle übernommen und gleichzeitig der Wert von dieser TextBox und einer anderen in eine andere Tabelle übernommen.
Nun zu meinem Problem:
die gewählten Daten der Tabelle werden in der Listbox anschliessend immer aktualisiert. Ist jedoch der letzte Eintrag vorhanden, wird dieser nicht mehr ordnungsgemäss nebeneinander aufgelistet sondern untereinander.
Damit ist der Datensatz nicht mehr wählbar.
Könnt ihr mir bitte bei der Lösung des Problems helfen.
Vorab erst einmal den Code zum Füllen der Listbox 3 und 4 nachstehend es betrifft jedoch nur ListBox4:
Private Sub UserForm_Activate()
'Anfang ListBox3
Dim iZeile3 As Long, i3 As Integer
Dim iCounter3 As Long: iCounter3 = 0
With ListBox3
.ColumnCount = 12
.ColumnWidths = "3,2cm;3cm;2,5cm;2,5cm;3cm;2,5cm;2,5cm;2,5cm;2,5cm;2,5cm;2,5 cm"
.Clear
End With
With Worksheets("Personaldatei_aktuell")
For iZeile3 = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
' If .Cells(iZeile, 5) = 0 Then
If iCounter3 = 0 Then
ReDim ar(12, iCounter3)
Else
ReDim Preserve ar(12, iCounter3)
End If
For i3 = 0 To 11
ar(i3, iCounter3) = .Cells(iZeile3, i3 + 1)
Next i3
ar(12, iCounter3) = iZeile3
iCounter3 = iCounter3 + 1
' End If
Next iZeile3
ListBox3.List = Application.Transpose(ar)
End With
'Ende Listbox3
'Anfang ListBox4
Dim iZeile4 As Long, i4 As Integer
Dim iCounter4 As Long: iCounter4 = 0
With ListBox4
.ColumnHeads = True
.ColumnCount = 10
.ColumnWidths = "3,2cm;3cm;2,5cm;2,5cm;3cm;2,5cm;2,5cm;2,5cm;2,5cm;2,5cm"
.Clear
End With
With Worksheets("Personaldatei_aktuell")
For iZeile4 = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
' If .Cells(iZeile4, 4) = 0 Then 'funktioniert nicht _
kein Ausschluss wenn Wert in Spalte A leer
If .Cells(iZeile4, 4) = 0 And .Cells(iZeile4, 1).Value "" Then 'funktioniert
' If .Cells(iZeile4, 4) = 0 And .Cells(iZeile4, 1) "" Then 'funktioniert auch
If iCounter4 = 0 Then
ReDim ar(11, iCounter4)
Else
ReDim Preserve ar(11, iCounter4)
End If
For i4 = 0 To 10
ar(i4, iCounter4) = .Cells(iZeile4, i4 + 1)
Next i4
ar(11, iCounter4) = iZeile4
iCounter4 = iCounter4 + 1
End If
Next iZeile4
ListBox4.List = Application.Transpose(ar)
End With
End Sub
Danke für eure Hilfe.
Sollte eine Musterdatei erforderlich sein, reiche ich diese nach.
Gruss
Peter
