一一添加自动筛选条件答案

【问题标题】：Adding AutoFilter Criteria one by one一一添加自动筛选条件
【发布时间】：2015-09-18 09:36:44
【问题描述】：

我想将自动筛选条件添加到我的 Excel 表格中的单独子项中。

我现在拥有的东西看起来有点像这样

.AutoFilter Field:=deviceTypeColumnId, Criteria1:=[dScenarioIndependent], Operator:=xlOr, _
                                       Criteria2:=[dSmartphoneDeviceType]

我想要的是一种方法，首先按 Criteria1 过滤，然后在另一个 Sub 中，将 Criteria2 添加到现有的 AutoFilter。在我看来，它应该是这样的：

Sub firstSub
    .AutoFilter Field:=deviceTypeColumnId, Criteria1:=[dScenarioIndependent]
end sub
Sub secondSub
    .AutoFilter mode:=xlAddCriteria, Field:=deviceTypeColumnId, Criteria1:=[dSmartphoneDeviceType]        
    'I know that mode doesn't exist, but is there anything like that?
end sub

你知道有什么方法可以实现吗？

【问题讨论】：

标签： excel vba autofilter

【解决方案1】：

据我所知，没有一种方法可以将条件“添加”到之前已应用的过滤器中。

我已经制作了一个变通方法，它适用于您正在尝试做的事情。您只需将场景添加到 select case 语句中，直至达到您希望拥有的最大过滤器数量。

编辑：它的作用；将过滤后的列复制到新工作表，并删除该列上的重复项。然后，您将获得用于过滤列的值。将值分配给数组，然后将数组的元素数应用为列上的过滤器，同时包括您希望过滤的新值。编辑 2：添加了一个函数来查找表已过滤时的最后一行（我们想要最后一行，而不是最后一个可见行）。

Option Explicit
Sub add_filter()
    Dim wb As Workbook, ws As Worksheet, new_ws As Worksheet
    Dim arrCriteria() As Variant, strCriteria As String
    Dim num_elements As Integer
    Dim lrow As Long, new_lrow As Long
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("data")

    Application.ScreenUpdating = False
    lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ws.Range("A1:A" & lrow).Copy 'Copy column which you intend to add a filter to
    Sheets.Add().Name = "filter_data"
    Set new_ws = wb.Sheets("filter_data")

    With new_ws
        .Range("A1").PasteSpecial xlPasteValues
        .Range("$A$1:$A$" & Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates _
        Columns:=1, Header:=xlYes   'Shows what has been added to filter
        new_lrow = Cells(Rows.Count, 1).End(xlUp).Row
        If new_lrow = 2 Then
            strCriteria = .Range("A2").Value 'If only 1 element then assign to string
        Else
            arrCriteria = .Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'If more than 1 element make array
        End If
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With

    If new_lrow = 2 Then
        num_elements = 1
    Else
        num_elements = UBound(arrCriteria, 1) 'Establish number elements in array
    End If

    lrow = last_row
    Select Case num_elements
        Case 1
            ws.Range("$A$1:$A$" & lrow).AutoFilter 1, _
            Array(strCriteria, "New Filter Value"), Operator:=xlFilterValues
        Case 2
            ws.Range("$A$1:$A$" & lrow).AutoFilter 1, _
            Array(arrCriteria(1, 1), arrCriteria(2, 1), _
            "New Filter Value"), Operator:=xlFilterValues
        Case 3
            ws.Range("$A$1:$A$" & lrow).AutoFilter 1, _
            Array(arrCriteria(1, 1), arrCriteria(2, 1), _
            arrCriteria(3, 1), "New Filter Value"), Operator:=xlFilterValues
    End Select
    Application.ScreenUpdating = True
End Sub

功能：

Function last_row() As Long
    Dim rCol As Range
    Dim lRow As Long

    Set rCol = Intersect(ActiveSheet.UsedRange, Columns("A"))
    lRow = rCol.Row + rCol.Rows.Count - 1
    Do While Len(Range("A" & lRow).Value) = 0
        lRow = lRow - 1
    Loop
    last_row = lRow
End Function

希望这会有所帮助。

【讨论】：