需求：编写Excel VBA代码实现按指定项筛选DataTable

完整代码实现 #

Sub Filter()
    Dim wsItems As Worksheet, wsData As Worksheet, wsStats As Worksheet
    Dim tblItems As ListObject, tblData As ListObject, tblStats As ListObject
    Dim visibleItems As Collection
    Dim dataRow As ListRow
    Dim col As ListColumn
    Dim item As Variant
    Dim hasAllItems As Boolean
    Dim statsStartRow As Long
    
    ' 绑定工作表与表格对象
    Set wsItems = ThisWorkbook.Worksheets("Items")
    Set wsData = ThisWorkbook.Worksheets("Data")
    Set tblItems = wsItems.ListObjects("ItemsTable")
    Set tblData = wsData.ListObjects("DataTable")
    
    ' 收集Items表中筛选后的可见项（自动去重）
    Set visibleItems = New Collection
    On Error Resume Next
    For Each dataRow In tblItems.ListRows
        If Not dataRow.Range.EntireRow.Hidden Then
            visibleItems.Add dataRow.Range.Value, Key:=CStr(dataRow.Range.Value)
        End If
    Next dataRow
    On Error GoTo 0
    
    ' 处理Stats工作表：存在则清空，不存在则新建
    On Error Resume Next
    Set wsStats = ThisWorkbook.Worksheets("Stats")
    On Error GoTo 0
    If wsStats Is Nothing Then
        Set wsStats = ThisWorkbook.Worksheets.Add(After:=wsData)
        wsStats.Name = "Stats"
    Else
        wsStats.Cells.Clear
    End If
    
    ' 复制DataTable表头到Stats表
    tblData.HeaderRowRange.Copy wsStats.Cells(1, 1)
    statsStartRow = 2
    
    ' 遍历DataTable，筛选包含所有可见项的行
    For Each dataRow In tblData.ListRows
        hasAllItems = True
        ' 检查当前行是否包含所有筛选出的项
        For Each item In visibleItems
            hasAllItems = False
            For Each col In tblData.ListColumns
                If dataRow.Range(col.Index).Value = item Then
                    hasAllItems = True
                    Exit For
                End If
            Next col
            If Not hasAllItems Then Exit For
        Next item
        
        ' 符合条件则复制行到Stats表
        If hasAllItems Then
            dataRow.Range.Copy wsStats.Cells(statsStartRow, 1)
            statsStartRow = statsStartRow + 1
        End If
    Next dataRow
    
    ' 在Stats表创建同结构表格
    If statsStartRow > 2 Then
        Set tblStats = wsStats.ListObjects.Add(xlSrcRange, wsStats.Range(wsStats.Cells(1, 1), wsStats.Cells(statsStartRow - 1, tblData.ListColumns.Count)), , xlYes)
        tblStats.Name = "StatsTable"
        ' 匹配原表格列宽
        For i = 1 To tblData.ListColumns.Count
            tblStats.ListColumns(i).Range.ColumnWidth = tblData.ListColumns(i).Range.ColumnWidth
        Next i
    End If
    
    ' 释放对象
    Set wsItems = Nothing
    Set wsData = Nothing
    Set wsStats = Nothing
    Set tblItems = Nothing
    Set tblData = Nothing
    Set tblStats = Nothing
    Set visibleItems = Nothing
End Sub

代码关键说明 #

• 获取可见项：遍历ItemsTable行，通过判断行隐藏状态收集非隐藏项，用Collection的Key参数自动去重，避免重复项干扰筛选逻辑。
• Stats表处理：先检查工作表是否存在，不存在则新建；存在则清空所有内容，避免残留旧数据。
• 核心筛选逻辑：逐行检查DataTable，只有当某行包含所有筛选出的Items项时，才将该行复制到Stats表，确保满足"同时包含所有选中项"的要求。
• 表格生成：复制数据后，基于Stats表的内容创建与DataTable结构一致的列表对象，并同步列宽，保证格式统一。

注意事项 #

• 确保ItemsTable和DataTable是Excel原生列表对象（而非普通单元格区域），否则代码会报错。
• 若ItemsTable筛选后无可见项，Stats表仅保留DataTable的表头，不会生成数据行。

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