Abhängige Comboboxen

Option Explicit
Const lSTARTZEILE As Long = 6
Private Sub UserForm_Initialize()
Call FillComboBox1
End Sub
Private Sub FillComboBox1()
Call MWFillComboBoxFromTableColumn(Personaldaten, 33, 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()
ComboBox4.Clear
ComboBox3.Clear
ComboBox2.Clear
If ComboBox1.ListIndex = -1 Then Exit Sub
Call MWFillComboBoxFromTableColumn(Personaldaten, 2, ComboBox2, 33, 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()
ComboBox4.Clear
ComboBox3.Clear
If ComboBox2.ListIndex = -1 Then Exit Sub
Call MWFillComboBoxFromTableColumn(Personaldaten, 3, ComboBox3, 33, ComboBox1.Text, 2, ComboBox2. _
Text)
If ComboBox3.ListCount >= 1 Then ComboBox3.ListIndex = 0
End Sub
Private Sub ComboBox3_Change()
ComboBox4.Clear
If ComboBox3.ListIndex = -1 Then Exit Sub
Call MWFillComboBoxFromTableColumn(Personaldaten, 15, ComboBox4, 33, ComboBox1.Text, 2, ComboBox2. _
Text, 3, ComboBox3.Text)
If ComboBox4.ListCount >= 1 Then ComboBox4.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 = "", _
Optional ByVal lColBedingung3 As Long = 0, Optional ByVal sBedingung3 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 lColBedingung3  0 Then
If LCase(Trim(CStr(oSheet.Cells(z, lColBedingung3))))  LCase(Trim( _
sBedingung3)) 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