Bitte Ralf, brauch DICH nochmal !
07.02.2022 16:26:19
wolfgang
Hallo Ralf,
habe in der 1 Spalte Nummerierung rausgenommen, allerdings die Spalte nicht gelöscht.
Es werden beim einlesen alle Daten angezeigt, allerdings nicht wenn ich die Combobox aufrufe, da werden die
Strassen angezeigt, bei einer Auswahl auch nichts.
Ich Test schon seit 3h rum, keine Ahnung.
Private Sub Userform_initialize()
Dim iIndex As Integer
Dim sBlattname As String
Dim letzteA As Long, z As Long
Dim dic As Object, arr
With Worksheets("Datenbank")
ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = "80;120;140;140;140;140;100"
ListBox1.Font.Size = 10
letzteA = .Cells(.Rows.Count, 2).End(xlUp).Row
ListBox1.List = .Range("B3:G" & letzteA).Value
arr = ListBox1.List
Set dic = CreateObject("Scripting.Dictionary")
For z = 1 To UBound(arr, 1)
dic(arr(z, 2)) = 0
Next
arr = WorksheetFunction.Transpose(dic.Keys)
ComboBox1.List = arr
ComboBox1.AddItem "Alle anzeigen", 0
ComboBox1.ListIndex = 0
Label5.Caption = .Range("a1")
End With
End Sub
Private Sub ComboBox1_Change()
Dim arr, arrData
Dim i As Long, cnt As Long
Dim loletzteA As Long
Dim rng As Range
With Worksheets("Datenbank")
loletzteA = .Cells(.Rows.Count, 2).End(xlUp).Row 'hier auf 2 (vorher1 )gesetzt da spalte 1nicht mehr genutzt wird
arr = .Range("B3:G" & loletzteA).Value
End With
With ListBox1
If ComboBox1.Value = "" Or ComboBox1.ListIndex = 0 Then .List = arr: Exit Sub
.RowSource = ""
.Clear
ReDim arrData(1 To UBound(arr), 1 To UBound(arr, 2))
For i = LBound(arr) To UBound(arr)
If ComboBox1 = arr(i, 2) Then
cnt = cnt + 1
arrData(cnt, 1) = arr(i, 1)
arrData(cnt, 2) = arr(i, 2)
arrData(cnt, 3) = arr(i, 3)
arrData(cnt, 4) = arr(i, 4)
arrData(cnt, 5) = arr(i, 5)
arrData(cnt, 6) = arr(i, 6)
End If
Next
If cnt = 0 Then Exit Sub
arrData = Application.Transpose(arrData)
ReDim Preserve arrData(1 To UBound(arr, 2), 1 To cnt)
If cnt = 1 Then .Column = arrData Else .List = Application.Transpose(arrData)
End With
End Sub
Bitte hilf mir, danke im Voraus,
gr wolfgang