逐条添加AutoFilter条件

Question

我想将AutoFilter标准添加到我的excel表中的单独的Subs中。

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

.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

你知道有什么方法可以做到这一点吗？

Answer 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

希望这能有所帮助。