一对一添加自动过滤条件 [英] Adding AutoFilter Criteria one by one

问题描述

我想在单独的Subs中将自动筛选条件添加到我的excel表中.

I would like to add AutoFilter Criteria to my excel table in separate Subs.

此刻我所拥有的看起来像这样

What I have at the moment looks a little something like this

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

我想拥有的一种方法是先按Criteria1进行过滤，然后在另一个Sub中将Criteria2添加到现有的AutoFilter中.在我看来，它应该看起来像这样:

What I would like to have is a method to first filter by Criteria1, and then, in another Sub, add Criteria2 to the existing AutoFilter. To my mind, it should look something like this:

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

您知道实现这一目标的任何方法吗?

Do you know any way to achieve this?

推荐答案

据我所知，没有一种将标准"添加"到以前应用的过滤器中的方法.

There isn't, that I know of, a way of "adding on" criteria to a filter which has previously been applied.

我已经制作了一种变通办法，该变通办法可以满足您的尝试.您只需将场景添加到select case语句中，即可达到所需的最大过滤器数量.

I have produced a work-around, which would work for what you are attempting to do. You will just have to add on scenarios to the select case statement, going up to the maximum number of filters which you will want to have.

它的作用；将已过滤的列复制到新的工作表，并删除该列上的重复项.然后剩下的是用于过滤列的值.将值分配给数组，然后将数组的元素数作为过滤器应用于列，同时包括希望过滤的新值.添加了一个函数，用于查找已过滤表的最后一行(我们需要最后一行，而不是最后一个可见行).

what it does; copy the filtered column to a new worksheet, and remove duplicates on that column. You're then left with the values which have been used to filter the column. Assign the values to an array, and then apply the number of elements of the array as a filter on the column, whilst including the new value you wish to filter on. EDIT 2: added in a function to find the last row for when a table is already filtered (we want the last row, not the last visible row).

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

希望这会有所帮助.

这篇关于一对一添加自动过滤条件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！