Betrifft: VBA - Listbox in Abhängigkeit füllen
von: Lucas H
Private Sub UserForm_Initialize()
Dim objDic As Object
Dim lngZ As Long
Set objDic = CreateObject("Scripting.Dictionary")
For lngZ = 4 To Sheets("Kundenliste (2)").Cells(Rows.Count, 12).End(xlUp).Row
objDic(Cells(lngZ, 12).Value) = 0
Next
Me.BoxOrt.List = objDic.keys
Dim iLast As Integer, iNext As Integer
Dim iTmp
With BoxOrt
For iLast = 0 To .ListCount - 1
For iNext = iLast + 1 To .ListCount - 1
If .List(iLast) > .List(iNext) Then
iTmp = .List(iLast)
.List(iLast) = .List(iNext)
.List(iNext) = iTmp
End If
Next iNext
Next iLast
End With
End Sub
2. Schritt.
Betrifft: AW: VBA - Listbox in Abhängigkeit füllen
von: 1713762.html
Betrifft: AW: VBA - Listbox in Abhängigkeit füllen
von: 1713934.html
Private Sub BoxOrt_Change()
Dim objDic As Object
Dim lngZ As Long
Dim iLast As Integer, iNext As Integer
Dim iTmp
Set objDic = CreateObject("Scripting.Dictionary")
BoxStrasse.Clear
Sheets("Kundenliste (2)").Activate
If Sheets("Kundenliste (2)").Cells(Rows.Count, 12).End(xlUp).Row = BoxOrt.Value Then
For lngZ = 4 To Sheets("Kundenliste (2)").Cells(Rows.Count, 9).End(xlUp).Row
objDic(Cells(lngZ, 9).Value) = 0
Next
Me.BoxStrasse.List = objDic.keys
With BoxStrasse
For iLast = 0 To .ListCount - 1
For iNext = iLast + 1 To .ListCount - 1
If .List(iLast) > .List(iNext) Then
iTmp = .List(iLast)
.List(iLast) = .List(iNext)
.List(iNext) = iTmp
End If
Next iNext
Next iLast
End With
On Error Resume Next
Else
End If
End Sub
Leider funktioniert es so aber nicht. Hast du ggf. einen besseren Vorschlag?
Betrifft: AW: VBA - Listbox in Abhängigkeit füllen
von: 1713946.html
Geschrieben am: 19.09.2019 17:25:24
SO benutzt man Dictionaries:
https://excelmacromastery.com/vba-dictionary/
Betrifft: AW: VBA - Listbox in Abhängigkeit füllen
von: 1713971.html
Geschrieben am: 19.09.2019 20:00:10
Moin!
Nein, den Anfang mit dem Abgleich meinte ich anders. Du solltest durch alle Zeilen gehen und dort Spalte 12 mit demORt vergelichen. WEnn dass stimmt, die Straße (Spalte 9 ) hinzufügen.
Sollte in etwa so aussehen:
Sheets("Kundenliste (2)").Activate
For lngZ = 4 To Sheets("Kundenliste (2)").Cells(Rows.Count, 12).End(xlUp).Row
If Sheets("Kundenliste (2)").Cells(lngZ, 12) = BoxOrt.Value Then
objDic(Sheets("Kundenliste (2)").Cells(lngZ, 9).Value) = 0
End If
Next
Me.BoxStrasse.List = objDic.keys