Lösungsvorschlag
30.12.2018 18:02:33
Beverly
code unter DieseArbeitsmappe:
Option Explicit
Private Sub Workbook_Open()
Dim objDic As Object
Dim varBereich As Variant
Dim lngZaehler As Long
Dim arrDaten As Variant
Set objDic = CreateObject("Scripting.Dictionary")
With Worksheets("DATA")
If .FilterMode Then .ShowAllData
varBereich = .ListObjects("tblData").DataBodyRange.Columns(6)
For lngZaehler = LBound(varBereich) To UBound(varBereich)
objDic(varBereich(lngZaehler, 1)) = 0
Next
arrDaten = objDic.keys
Worksheets("MAIN").CB_CLT.List = WorksheetFunction.Transpose(arrDaten)
End With
Set objDic = Nothing
End Sub
Code im Codemodul des Tabellenblattes MAIN:
Option Explicit
Private Sub CB_CLT_Change()
Dim objDic As Object
Dim varBereich As Variant
Dim lngZaehler As Long
Dim arrDaten As Variant
If CB_CLT.ListIndex -1 Then
Set objDic = CreateObject("Scripting.Dictionary")
With Worksheets("DATA")
If .FilterMode Then .ShowAllData
.ListObjects("tblData").Range.AutoFilter Field:=6, Criteria1:=CB_CLT
varBereich = .ListObjects("tblData").DataBodyRange.Columns(7).SpecialCells( _
xlCellTypeVisible)
For lngZaehler = LBound(varBereich) To UBound(varBereich)
objDic(varBereich(lngZaehler, 1)) = 0
Next
.ListObjects("tblData").Range.AutoFilter Field:=6
End With
arrDaten = objDic.keys
Worksheets("MAIN").CB_LT.List = WorksheetFunction.Transpose(arrDaten)
Set objDic = Nothing
End If
End Sub