Option Explicit
Public Sub Anwendungsbeispiel()
Dim vntValues As Variant
Call GetUniqueCarBrands(vntValues)
ComboBox1.List = vntValues
If ComboBox1.ListCount = 0 Then
Exit Sub
End If
ComboBox1.ListIndex = 0
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex < 0 Then Exit Sub
Dim vntValues As Variant
Call GetUniqueCarModells(ComboBox1.Value, vntValues)
ComboBox2.List = vntValues
ComboBox2.ListIndex = -1
End Sub
Public Function GetUniqueCarModells(CarBrand As String, Optional Values As Variant) As Long
Dim rngTable As Excel.Range
Set rngTable = GetTableRange()
If rngTable Is Nothing Then
GoTo NoValuesFound
End If
Dim vntResult As Variant
vntResult = WorksheetFunction.Filter(rngTable, Me.Evaluate(rngTable.Columns(1).Address & "=""" & CarBrand & """"))
If IsError(vntResult) Then
GoTo NoValuesFound
End If
vntResult = WorksheetFunction.Index(vntResult, 0, 2)
vntResult = WorksheetFunction.Transpose(vntResult)
vntResult = WorksheetFunction.Unique(vntResult, True)
Values = vntResult
GetUniqueCarModells = UBound(Values)
Exit Function
NoValuesFound:
Values = Split(vbNullString)
GetUniqueCarModells = 0
End Function
Public Function GetUniqueCarBrands(Optional Values As Variant) As Long
Dim rngTable As Excel.Range
Set rngTable = GetTableRange()
If rngTable Is Nothing Then
GoTo NoValuesFound
End If
Dim vntResult As Variant
vntResult = WorksheetFunction.Unique(rngTable.Columns(1).Value)
vntResult = WorksheetFunction.Transpose(vntResult)
Values = vntResult
GetUniqueCarBrands = UBound(Values)
Exit Function
NoValuesFound:
Values = Split(vbNullString)
GetUniqueCarBrands = 0
End Function
Private Function GetTableRange() As Excel.Range
Dim rngTable As Excel.Range
Set rngTable = Range("A1").CurrentRegion
If rngTable.Rows.Count > 1 Then
Set GetTableRange = rngTable.Offset(1).Resize(rngTable.Rows.Count - 1)
End If
End Function