如何让ComboBox依赖已筛选的Excel表格实现联动？

需求背景 #

我有如下Excel表格：
Excel表格截图
当前已通过用户窗体（截图如下）和命令按钮实现基础筛选功能，现有代码如下：
用户窗体截图

Sub standardfilter()

    Dim ws As Worksheet
    Dim tbl As ListObject
    
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("Tabelle1")
    
    With tbl.Range
        
        .AutoFilter field:=1, Criteria1:=Gremienauswahl.ComboBox1.Value, Operator:=xlAnd
        .AutoFilter field:=2, Criteria1:=">=" & CLng(Date), Operator:=xlAnd
        
    End With
    
    Range("Tabelle1").Sort Key1:=Range("D5"), Order1:=xlAscending, Header:=xlYes
    
End Sub

现在想实现：先通过ComboBox1选择第1列的“Gremium（委员会）”值，再让ComboBox2自动显示该委员会对应的所有可用日期值，是否可行？

实现方法 #

完全可以实现，按以下步骤操作即可：

1. 给ComboBox1加载所有委员会选项 #

打开用户窗体的代码窗口，添加初始化事件，将表格第1列的唯一委员会值加载到ComboBox1：

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim cell As Range
    Dim uniqueGremien As Collection
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("Tabelle1")
    Set uniqueGremien = New Collection
    
    ' 遍历第1列，收集不重复的委员会名称
    On Error Resume Next
    For Each cell In tbl.ListColumns(1).DataBodyRange
        uniqueGremien.Add cell.Value, Key:=CStr(cell.Value)
    Next cell
    On Error GoTo 0
    
    ' 将收集到的名称添加到ComboBox1
    For Each item In uniqueGremien
        ComboBox1.AddItem item
    Next item
End Sub

2. 选择委员会后自动更新ComboBox2的日期选项 #

给ComboBox1添加Change事件，选中委员会后，自动筛选对应可用日期（大于等于当前日期）并加载到ComboBox2：

Private Sub ComboBox1_Change()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim cell As Range
    Dim uniqueDates As Collection
    Dim selectedGremium As String
    
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("Tabelle1")
    selectedGremium = ComboBox1.Value
    Set uniqueDates = New Collection
    
    ' 清空ComboBox2原有内容
    ComboBox2.Clear
    
    ' 未选择委员会时直接退出
    If selectedGremium = "" Then Exit Sub
    
    ' 遍历日期列，收集对应委员会的不重复可用日期
    On Error Resume Next
    For Each cell In tbl.ListColumns(2).DataBodyRange
        ' 匹配委员会且日期不早于当前日期
        If tbl.ListColumns(1).DataBodyRange(cell.Row - tbl.HeaderRowRange.Row).Value = selectedGremium And cell.Value >= Date Then
            uniqueDates.Add cell.Value, Key:=CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' 将日期添加到ComboBox2
    For Each item In uniqueDates
        ComboBox2.AddItem item
    Next item
End Sub

3. 修改原筛选代码支持日期选择 #

更新原standardfilter子程序，支持用ComboBox2选中的日期进行筛选：

Sub standardfilter()
    Dim ws As Worksheet
    Dim tbl As ListObject
    
    Set ws = ActiveSheet
    Set tbl = ws.ListObjects("Tabelle1")
    
    ' 清除原有筛选状态
    tbl.Range.AutoFilter
    
    With tbl.Range
        ' 筛选选中的委员会
        If ComboBox1.Value <> "" Then
            .AutoFilter field:=1, Criteria1:=ComboBox1.Value
        End If
        ' 日期筛选：若ComboBox2有选中值则用该值，否则保留原逻辑筛选今日及以后日期
        If ComboBox2.Value <> "" Then
            .AutoFilter field:=2, Criteria1:=ComboBox2.Value
        Else
            .AutoFilter field:=2, Criteria1:=">=" & CLng(Date)
        End If
    End With
    
    ' 按表格第4列排序（替换原代码中固定单元格引用，更稳妥）
    tbl.Sort Key1:=tbl.ListColumns(4).Range, Order1:=xlAscending, Header:=xlYes
End Sub

注意事项 #

• 确保用户窗体中控件名称为ComboBox1和ComboBox2，若自定义名称需对应修改代码
• 表格对象名称为Tabelle1，若你的表格名称不同请同步调整代码中的对应字段
• 若不需要“仅显示今日及以后日期”的逻辑，可删除日期收集代码中的And cell.Value >= Date判断

内容的提问来源于stack exchange，提问作者BlankerHans