Voneinander abhängige ComboBoxen erstellen
Ausgangslage - Was tut dieser Code-Schnipsel?
Immer wieder gibt es in Foren die Frage: Wie erstellt man voneinander abhängige ComboBoxen?
Aus diesem Grund habe ich ein kleines, stark vereinfachtes Beispiel vorbereitet:
| A | B | C | D | E | |
|---|---|---|---|---|---|
| 1 | Kategorie 1 | Kategorie 2 | Kategorie 3 | Weitere Spalten ... | |
| 2 | Gruppe 1 | Gemüse | Kartoffel | ||
| 3 | Gruppe 1 | Gemüse | Zwiebel | ||
| 4 | Gruppe 2 | Kräuter | Schnittlauch | ||
| 5 | Gruppe 3 | Obst | Apfel | ||
| 6 | Gruppe 3 | Obst | Birne | ||
| 7 | |||||
| 8 |
Ziel ist es, drei ComboBoxen (Namen im Code: ComboBox1, ComboBox2 und ComboBox3) abhängig voneinander zu befüllen.
Ein kleines Beispiel: In der ersten ComboBox wähle ich "Gruppe 1" aus.
Diese Auswahl soll zur Folge haben, dass ComboBox2 und ComboBox3 neu gefüllt werden. Allerdings sollen nur die Einträge zur "Gruppe 1" verwendet werden. Für "Gruppe 1" wäre das nur das "Gemüse" aus Spalte 2.
Für die ComboBox3 werden dann nur die Möglichkeiten bereitgestellt, bei denen "Gruppe 1" sowie "Gemüse" vorkommt. In diesem Fall die "Kartoffel" und die "Zwiebel".
Zusatz: Es soll keine doppelten Einträge in den ComboBoxen geben!
Folgend ein Beispielquelltext für eine UserForm mit drei ComboBoxen und der dazugehörigen Tabelle1.
Der Quelltext
Option Explicit
' Original-Quelltext unter: https://www.online-vba.de/voneinander-abhaengige-comboboxen-erstellen
' Express-Hilfe für VBA unter https://www.online-vba.de/vba-expresshilfe
' Es gelten die Nutzungsbedingungen von Online-VBA.de
Const lSTARTZEILE As Long = 2
Private Sub UserForm_Initialize()
Call FillComboBox1
End Sub
Private Sub FillComboBox1()
Call OVBAde_FillComboBoxFromTableColumn(Tabelle1, 1, ComboBox1)
If ComboBox1.ListCount >= 1 Then ComboBox1.ListIndex = 0
End Sub
'Ereignisroutine, wenn sich ComboBox1 verändert -> ComboBox2 und 3 neu füllen
Private Sub ComboBox1_Change()
ComboBox3.Clear
ComboBox2.Clear
If ComboBox1.ListIndex = -1 Then Exit Sub
Call OVBAde_FillComboBoxFromTableColumn(Tabelle1, 2, ComboBox2, 1, ComboBox1.Text)
If ComboBox2.ListCount >= 1 Then ComboBox2.ListIndex = 0
End Sub
'Ereignisroutine, wenn sich ComboBox2 verändert -> ComboBox3 neu füllen
Private Sub ComboBox2_Change()
ComboBox3.Clear
If ComboBox2.ListIndex = -1 Then Exit Sub
Call OVBAde_FillComboBoxFromTableColumn(Tabelle1, 3, ComboBox3, 1, ComboBox1.Text, 2, ComboBox2.Text)
If ComboBox3.ListCount >= 1 Then ComboBox3.ListIndex = 0
End Sub
Private Sub OVBAde_FillComboBoxFromTableColumn(ByRef oSheet As Object, _
ByVal lColumn As Long, ByRef oComboBox As Object, _
Optional ByVal lColBedingung1 As Long = 0, Optional ByVal sBedingung1 As String = "", _
Optional ByVal lColBedingung2 As Long = 0, Optional ByVal sBedingung2 As String = "")
Dim z As Long
Dim zMax As Long
Dim bFlag As Boolean
oComboBox.Clear
zMax = oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count - 1
For z = lSTARTZEILE To zMax
If Trim(CStr(oSheet.Cells(z, lColumn).Value)) <> "" Then
bFlag = True
If lColBedingung1 <> 0 Then
If LCase(Trim(CStr(oSheet.Cells(z, lColBedingung1)))) <> LCase(Trim(sBedingung1)) Then
bFlag = False
End If
End If
If lColBedingung2 <> 0 Then
If LCase(Trim(CStr(oSheet.Cells(z, lColBedingung2)))) <> LCase(Trim(sBedingung2)) Then
bFlag = False
End If
End If
If bFlag = True Then
Call OVBAde_FillNonDuplicatesToComboBox(oComboBox, oSheet.Cells(z, lColumn).Value)
End If
End If
Next z
End Sub
Private Sub OVBAde_FillNonDuplicatesToComboBox(ByRef oComboBox As Object, ByVal sAddText As String)
Dim i As Long
Dim bFlag As Boolean
If oComboBox.ListCount = 0 Then
oComboBox.AddItem sAddText
Else
bFlag = False
For i = 0 To oComboBox.ListCount - 1
If LCase(Trim(CStr(oComboBox.List(i)))) = LCase(Trim(CStr(sAddText))) Then
bFlag = True
Exit For
End If
Next i
If bFlag = False Then
oComboBox.AddItem sAddText
End If
End If
End Sub
Anmerkungen und Hinweise
Dieser Codeschnipsel wurde geschrieben von Marc Wershoven im Jahr 2014.
Die Nutzung erfolgt auf eigene Gefahr.
Bitte denken Sie immer zuerst an eine ausreichende Datensicherung.
Wir können keinen kostenlosen Support anbieten.
Es gelten unsere Nutzungsbedingungen.
