UF Drobdowns in Abhängikeit mehrere Faktoren
31.05.2019 21:41:04
Matthias
Ich bastel gerade an einer Userform in der 20 Dropdowns zur Verfügung stehen.
Linke Dropdowns ist jeweils die Ware, das rechte Userform ist jewels der Standort.
Die Werte kommen aus einem Tabellenblatt.
Nun zu meinem Problem:
Ware 1 (standort 1) kann zum Beispiel nur zu Ware 6 (standort 6) geliefert werden.
die Dropdowns sind also in abhängikeit gebunden, was ich auch bis zur station 2 hinbekommen habe. Wobei ich den Zielstandort noch nicht hinbekommen habe in abhängigkeit der 3 vorherigen angaben...
Nun ist mein hauptproblem, Station 2 ist ja dann automatisch wieder wieder der startpunkt und Station 3 der Zielpunkt.
Wie kann ich die Rückprüfung durchführen lassen, da das im Prinzip ja 2 change-ereignisse sind die den Listindex des Dropdowns füllen?
Option Explicit
Private Sub leave_Click()
Unload Me
Application.Visible = True
End Sub
Private Function FilterInitiale()
Dim oDic As Object, ArData
Dim n&
With Fahrplan_Daten
ArData = .Range("C3", .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 3).Value2
End With
Set oDic = CreateObject("Scripting.Dictionary")
For n = LBound(ArData) To UBound(ArData)
If ArData(n, 1) "" Then oDic(ArData(n, 1)) = 0
Next
If oDic.Count > 0 Then FilterInitiale = oDic.keys
End Function
Private Sub UserForm_Initialize()
Dim ArData, i%
ArData = FilterInitiale
If IsArray(ArData) Then
Ware1.List = ArData
If Ware1.ListIndex = -1 Then Ware1.Value = ""
End If
End Sub
Private Function FilterStation(SuchWert$)
Dim oDic As Object, ArData
Dim n&
With Fahrplan_Daten
ArData = .Range("C3", .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 4).Value2
End With
Set oDic = CreateObject("Scripting.Dictionary")
For n = LBound(ArData) To UBound(ArData)
If ArData(n, 1) = SuchWert Then oDic(ArData(n, 2)) = 0
Next
If oDic.Count > 0 Then FilterStation = oDic.keys
End Function
Private Sub Ware1_Change()
Dim ArData, i%
ArData = FilterStation(Ware1.Value)
With Station1
If IsArray(ArData) Then
.List = ArData
If .ListIndex = -1 Then .ListIndex = -1
Else
.Clear
End If
End With
End Sub
Private Function FilterZiel(SuchWert$)
Dim oDic As Object, ArData
Dim n&, nn&, sStart$
With Fahrplan_Daten
ArData = .Range("C3", .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 5).Value2
End With
sStart = Ware1.Value
If sStart = "" Then Exit Function
Set oDic = CreateObject("Scripting.Dictionary")
For n = LBound(ArData) To UBound(ArData)
If ArData(n, 1) = sStart Then
If ArData(n, 2) = SuchWert Then
For nn = 3 To UBound(ArData, 2)
If ArData(n, 3) "" Then oDic(ArData(n, 3)) = 0
Next nn
End If
End If
Next
If oDic.Count > 0 Then FilterZiel = oDic.keys
End Function
Private Sub Station1_Change()
Dim ArData, i%
ArData = FilterZiel(Station1.Value)
With Ware2
If IsArray(ArData) Then
.List = ArData
If .ListIndex = -1 Then .ListIndex = -1
Else
.Clear
End If
End With
End Sub
Beispieldatei: https://www.herber.de/bbs/user/130136.xlsm
Liebe Grüße,
Matthias