Abhängige Dropdowns
25.09.2022 23:43:18
Marcel
leider kann ich auf meinen alten Beitrag (https://www.herber.de/forum/archiv/1896to1900/1898112_vba_Eingabe_Fenster_programmieren.html#1898215) nicht mehr antworten.
Daher hier:
Userform:
Ich möchte, dass als Ergebnis der Userform ein 4-stelliges Kürzel aus Spalte "I" (Tabellenblatt Datenquelle) in der Zelle B6 (Tabellenblatt Übersicht) ausgegeben wird.
Ich habe diese Test Datei erstellt.
https://www.herber.de/bbs/user/155371.xlsm
Die o.g. Userform soll mit abhängigen Dropdown-Feldern auf die Datenquelle zugreifen und einmalige Werte in den Dropdownfeldern anzeigen. Spaltennamen der Datenquelle sind analog zu den Kombinationsfeldern der Userform.
Die Userform habe ich bereits erstellt, komme allerdings bei den Codes der Kombinationsfelder und vom OK Button nicht mehr weiter - ich bin wenn überhaupt absoluter vba Anfänger.
Momentan wirft er mir im Kombifeld Produktgruppe immer doppelte Werte aus und im letzten Kombifeld genauso. Ich habe mich total festgefahren.
Kann mir hier jemand helfen und sagen wie die Userform dann auch aus der gewählten Produktuntergruppe das dazugehörige Kürzel aus der Datenquelle in Zelle B6 auswirft?
'Dropdown Feld "Produktgruppe" aktivieren und befüllen
Private Sub cbProduktklasse_Change()
'cbProduktgruppe zurücksetzen
cbProduktgruppe.Clear
'cbProduktgruppe freischalten
cbProduktgruppe.Enabled = True
'cbProduktgruppe befüllen
Dim Zeile As Long
Dim tbl As ListObject
Set tbl = ShDatenquelle.ListObjects("tblDatenquelle")
'Schleife über alle Zeilen der Tabelle; "tbl.datab......count" steht für letzte Zeile
For Zeile = 1 To tbl.DataBodyRange.Rows.Count
'Prüfen, ob die Auswahl in cbProduktklasse mit dem Wert in der Zeile übereinstimmt
If cbProduktklasse.Value = tbl.DataBodyRange(Zeile, 4).Value Then
'Wert der cbProduktgruppe zuweisen
cbProduktgruppe.AddItem tbl.DataBodyRange(Zeile, 6).Value
End If
Next Zeile
End Sub
'Dropdown Feld "Produktuntergruppe" aktivieren und befüllen
Private Sub cbProduktgruppe_Change()
'cbProduktgruppe zurücksetzen
cbProduktuntergruppe.Clear
'cbProduktgruppe freischalten
cbProduktuntergruppe.Enabled = True
'cbProduktgruppe befüllen
Dim Zeile As Long
Dim tbl As ListObject
Set tbl = ShDatenquelle.ListObjects("tblDatenquelle")
'Schleife über alle Zeilen der Tabelle; "tbl.datab......count" steht für letzte Zeile
For Zeile = 1 To tbl.DataBodyRange.Rows.Count
'Prüfen, ob die Auswahl in cbProduktklasse mit dem Wert in der Zeile übereinstimmt
If cbProduktgruppe.Value = tbl.DataBodyRange(Zeile, 6).Value Then
'Wert der cbProduktgruppe zuweisen
cbProduktuntergruppe.AddItem tbl.DataBodyRange(Zeile, 8).Value
End If
Next Zeile
End Sub
'läuft immer dann ab, wenn Userform zum ersten Mal initialisiert wird
Private Sub UserForm_Initialize()
'Variablen dimensionieren
Dim oDic As Object
Set oDic = CreateObject("scripting.dictionary")
Dim Cell As Range
'Schleife über kompletten Zellbereich
For Each Cell In ShDatenquelle.Range("tblDatenquelle[Produktklasse]")
'Zellwert in Dictionary einlesen, falls noch nicht vorhanden
oDic(Cell.Value) = 0
Next Cell
'Combobox mit Dictionary-Keys befüllen
cbProduktklasse.List = oDic.keys
End Sub
Marcel
