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 |
Option Explicit
' ****************************************************************
' Autor/en und Original-Quelltext unter:
' https://www.online-vba.de/vba_abhcomboboxen.php
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von https://www.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