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 | ||
| 2 | Gruppe 1 | Gemüse | Zwiebel | ||
| 2 | Gruppe 2 | Kräuter | Schnittlauch | ||
| 2 | Gruppe 3 | Obst | Apfel | ||
| 2 | Gruppe 3 | Obst | Birne |
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 bereitsgestellt,
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.
Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_abhcomboboxen.php
' ************************************************************************************************
Const lSTARTZEILE As Long = 2
Private Sub UserForm_Initialize()
Call FillComboBox1
End Sub
Private Sub FillComboBox1()
Call MWFillComboBoxFromTableColumn(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 MWFillComboBoxFromTableColumn(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 MWFillComboBoxFromTableColumn(Tabelle1, 3, ComboBox3, 1, ComboBox1.Text, 2, ComboBox2.Text)
If ComboBox3.ListCount >= 1 Then ComboBox3.ListIndex = 0
End Sub
Private Sub MWFillComboBoxFromTableColumn(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 MWFillNonDuplicatesToComboBox(oComboBox, oSheet.Cells(z, lColumn).Value)
End If
End If
Next z
End Sub
Private Sub MWFillNonDuplicatesToComboBox(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
Autor: Marc Wershoven (2014)
VBA Programmierer gesucht?
http://www.WershovenOnline.de
Sie haben beispielsweise eine Frage zu einer Ihrer eigenen Makroprogrammierungen in VBA? Oder Sie suchen Unterstützung und Informationen über eine bestimmte Microsoft® Excel® Formel? Bei nahezu allen Fragen und Problemen rund um Microsoft® Office und VBA Makros steht Ihnen unser individueller Quick E-Mail Support zur Verfügung. Einfach, schnell und unkompliziert Ihre Frage in einer E-Mail formulieren, mit oder ohne Screenshots oder einer Beispieldatei absenden und kurze Zeit später haben Sie eine vollständige Lösung inkl. ausführlicher Erklärung vom Profi in Ihrem Postfach!
Zusätzlich besteht die Option, dass wir uns mittels Fernwartung (selbstverständlich nach Ihrem Einvertändnis) direkt "live" mit Ihnen zusammen an Ihrem Bildschirm gemeinsam Fragen und Problemstellungen anschauen und lösen können!
Weitere Informationen zu diesem kostenpflichtigen Angebot finden Sie auf der Anbieterseite von WershovenOnline® auf www.wershovenonline.de.
Zum Anbieter des Quick-E-Mail-Support...
