VBA Excel自定义文本filter由两个以上的文本组成

我有一个长表，通常我想通过多个值筛选资产编号（从第4行到第3080行的第一列和第一行）。 Excel自定义文本filter不能过滤两个以上的文本。 我想知道是否有可能过滤两个以上。 我知道这可能在VBA中。

例如，将列A过滤为“85254”，“8782A”和“GH0012”

Answer 1

您只需使用“ 高级筛选”选项即可实现同样的效果。 它足够聪明，可以在多列和两个以上的值上过滤数据。

您只需创build“ 过滤条件”部分，其中列名必须与数据范围的列名相似，并且可以位于同一张表中或另一张表中。 在标准范围内，您可以指定任意数量的值和多列。

我已经在我的例子下面的截图中说明了这一点。 点击高级filter对话框中的确定button，你的date将被过滤掉。

Answer 2

这是一些代码。 只需在ValuesToFiltervariables中input要筛选的值，在列中的某处select一个单元格以过滤并运行代码。 它在表和非正式列表中起作用：

 Sub FilterList() Dim ValuesToFilter As String Dim FilterValues() As String Dim ColNumberInFilterRange As Long Dim FilterRange As Excel.Range Dim InTable As Boolean Dim CollUniqueValues As Collection Dim i As Long ValuesToFilter = "85254,8782A,GH0012" 'comma-separated string If ActiveSheet Is Nothing Then MsgBox "No active worksheet." Exit Sub End If With Selection If .Cells.Count = 1 And IsEmpty(ActiveCell) Then MsgBox "Please select a cell within one or more cells with data." Exit Sub End If If Union(ActiveCell.EntireColumn, .EntireColumn).Address <> ActiveCell.EntireColumn.Address Then MsgBox "Only select from one column" Exit Sub End If 'Set the range to be filtered depending on whether it's a Table or not If Not ActiveCell.ListObject Is Nothing Then Set FilterRange = ActiveCell.ListObject.Range InTable = True Else Set FilterRange = ActiveCell.CurrentRegion End If If Union(Selection, FilterRange).Address <> FilterRange.Address Then MsgBox "Please make sure all cells are within the same table or contiguous area." Exit Sub End If 'If not in a table and we're filtering a different area than currently filtered 'then turn the existing AutoFilter off, so no error when the new area gets filtered. If Not InTable And ActiveSheet.AutoFilterMode Then If ActiveSheet.AutoFilter.Range.Address <> .CurrentRegion.Address Then ActiveSheet.AutoFilterMode = False End If End If FilterValues = Split(ValuesToFilter, ",") 'Try to add every selected value to a collection - only unique values will succeed Set CollUniqueValues = New Collection For i = LBound(FilterValues) To UBound(FilterValues) On Error Resume Next CollUniqueValues.Add FilterValues(i) On Error GoTo 0 Next i 'Transfer the collection to an array for the AutoFilter function ReDim FilterValues(1 To CollUniqueValues.Count) For i = LBound(FilterValues) To UBound(FilterValues) FilterValues(i) = CollUniqueValues(i) Next i 'Determine the index of the column to be filtered within the FilterRange ColNumberInFilterRange = (.Column - FilterRange.Columns(1).Column) + 1 FilterRange.AutoFilter Field:=ColNumberInFilterRange, Criteria1:=FilterValues, Operator:=xlFilterValues End With End Sub 

这个代码是从我的这个职位修改，在那里你input值到一个用户窗体。 如果你做了这么多，你可能要下载示例工作簿。 我之前的post是关于按列中所有选定的值进行过滤。