Question

我想在单独的Subs。

中将AutoFilter Criteria添加到我的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

你知道有什么方法可以达到这个目的吗？

Answer 1

我知道，并没有一种方式可以加入＆＃34;先前已应用过滤器的标准。

我已经制作了一个解决方案，它可以用于你想要做的事情。您只需要在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

希望这有帮助。

逐个添加AutoFilter Criteria

1 个答案: