AW: Sechsfach abhängige Comboboxen
19.07.2013 12:46:16
Rudi
Hallo,
zu 1:
Option Explicit
Dim bolCode As Boolean, strID As String
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_initialize()
Dim MyDic As Object, Zelle As Range
Set MyDic = CreateObject("Scripting.Dictionary")
With Worksheets("Tabelle1")
For Each Zelle In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
MyDic(Zelle.Value) = Zelle.Value
Next Zelle
End With
ComboBox1.List = MyDic.items
End Sub
Private Sub ComboBox1_Change()
If Not bolCode Then
bolCode = True
ClearCombo 1
ComboBox2.List = GetList(1)
TextBox1 = strID
bolCode = False
End If
End Sub
Private Sub ComboBox2_Change()
If Not bolCode Then
bolCode = True
ClearCombo 2
ComboBox3.List = GetList(2)
TextBox1 = strID
bolCode = False
End If
End Sub
Private Sub ComboBox3_Change()
If Not bolCode Then
bolCode = True
ClearCombo 3
ComboBox4.List = GetList(3)
TextBox1 = strID
bolCode = False
End If
End Sub
Private Sub ComboBox4_Change()
If Not bolCode Then
bolCode = True
ClearCombo 4
ComboBox5.List = GetList(4)
TextBox1 = strID
bolCode = False
End If
End Sub
Private Sub ComboBox5_Change()
If Not bolCode Then
bolCode = True
ClearCombo 5
ComboBox6.List = GetList(5)
TextBox1 = strID
bolCode = False
End If
End Sub
Private Sub ComboBox6_Change()
GetList (6)
TextBox1 = strID
End Sub
Function GetList(iCombobox As Integer)
Dim i As Integer, Zelle As Range, bolOK As Boolean, objList As Object
Set objList = CreateObject("Scripting.Dictionary")
strID = ""
With Sheets("Tabelle1")
For Each Zelle In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
bolOK = True
For i = 1 To iCombobox
bolOK = bolOK And CStr(Zelle.Offset(, i - 1)) = Controls("Combobox" & i)
Next
If bolOK Then
objList(.Cells(Zelle.Row, iCombobox + 1).Value) = _
.Cells(Zelle.Row, iCombobox + 1).Value
If strID = "" Then strID = .Cells(Zelle.Row, 7)
End If
Next
End With
If objList.Count > 1 Then strID = ""
GetList = objList.items
End Function
Sub ClearCombo(iCombobox As Integer)
Dim i As Integer
For i = iCombobox + 1 To 6
Controls("ComboBox" & i).Clear
Next
End Sub
Gruß
Rudi