按列表过滤表格答案

【问题标题】：Filter table by list按列表过滤表格
【发布时间】：2015-03-27 12:13:35
【问题描述】：

我有一个表，其中第一列是名称列表（在本例中为食物列表），我需要通过使用列表过滤此列来对表进行排序。在这种情况下，我需要按“水果”或“甜点”对“食物”表进行排序，这样如果在单元格“E1”中选择了“水果”，该表将只显示食物为“苹果”的行”、“香蕉”或“葡萄”。

我试过用 Excel/Vba 的INDIRECT 函数做依赖下拉列表，但是没有用。

这甚至可以在 Excel 中完成吗？如果这需要使用 VBA 来完成，我该怎么做？

【问题讨论】：

什么不起作用？您是否设置了命名范围并将验证定向到适当的单元格？您是否确保连接没有被绝对引用（$ 符号）阻塞？
很抱歉没有添加。是的，我确实尝试过命名范围并在单元格中使用数据验证来显示列表。我确实让它工作了（引用列表将使用INDIRECT 显示在单元格中），但我不知道如何使用具有列表数据验证的单元格来过滤表。
另外，我开始使用命名范围为此编写一些 VBA 代码。如果我让它工作，我会发布我的解决方案。

标签： excel excel-formula vba

【解决方案1】：

如果你坚持使用VBA...

Sub ert()

ListName = Range("F1") 'the filter cell, e.g. "Dessert"
ListNumerosity = Range(ListName).Cells.Count 'counts the numerosity of your list
Dim MyList() As String 'creates list
ReDim MyList(1 To ListNumerosity) 'sets numerosity of list
Dim rng As Range
For Each rng In Range(ListName) 'for each cell in your filter, e.g. "Dessert"
i = i + 1
    MyList(i) = rng 'collect the cell values  into a list
Next

    ActiveSheet.ListObjects("Táblázat3").Range.AutoFilter Field:=1, Criteria1:=MyList(), Operator:=xlFilterValues 'replace Táblázat3 with your tablename, does filtering to your list
End Sub

有关更多规格和 f'd 试验，请参阅我的 uploaded file。

【讨论】：

【解决方案2】：

这是我最终使用的整个模块。

 Sub FilterByArray()

    Dim ary As Variant, Idx As Long, Jdx As Long
    Dim numCols As Long, numRows As Long
    Dim food As String, year As String
    food = "Food"
    year = "2015"
    numNamedRanges = 0

    SetDataValidation food, year

    Sheets(food).Activate
    numCols = Sheets(food).Range("A2", Range("Z2").End(xlToLeft)).SpecialCells(xlCellTypeVisible).Cells.Count
    For Idx = 1 To numCols
        numRows = Sheets(food).Range(Cells(2, Idx).Address, Range(Cells(499, Idx).Address).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells.Count
'           Add named ranges for 1 to numRows for each column in 1 to numCols
        ActiveWorkbook.Names.Add Name:=Cells(1, Idx).Value, RefersTo:="=" & Cells(2, Idx).Address & ":" & Cells(numRows + 1, Idx).Address
    Next Idx

    For Idx = 1 To numCols
        If Sheets(year).Cells(1, 6).Value = Sheets(food).Cells(1, Idx).Value Then
            numRows = Sheets(food).Range(Cells(2, Idx).Address, Range(Cells(499, Idx).Address).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells.Count
            ReDim ary(1 To numRows)
            For Jdx = 1 To numRows
                ary(Jdx) = Cells(Jdx + 1, Idx).Value
            Next Jdx
            Sheets(year).ListObjects(1).Range.AutoFilter Field:=1, Criteria1:= _
                ary, Operator:=xlFilterValues
            Exit For
        End If
    Next Idx
    Sheets(year).Activate

End Sub

Sub SetDataValidation(food As String, year As String)

    Dim listArray As Variant, Idx As Long
    Dim numCols As Long

    Sheets(food).Activate
    numCols = Sheets(food).Range("A2", Range("Z2").End(xlToLeft)).SpecialCells(xlCellTypeVisible).Cells.Count

    ReDim listArray(1 To numCols)
    For Idx = 1 To numCols
        listArray(Idx) = Cells(1, Idx).Value
    Next Idx

    Sheets(year).Range("F1").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=Join(listArray, ",")

End Sub

【讨论】：