逐个添加AutoFilter标准

我想添加AutoFilter标准到我的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

我所知道的是，一种“添加”标准的方法应用于先前已应用的filter。

我已经制定了一个解决方法，这将为你正在尝试做的工作。 你将只需要添加场景到select案例语句，上涨到你想要的最大数量的filter。

编辑：它做了什么; 将过滤的列复制到新的工作表中，并删除该列上的重复项。 然后，您将留下用于过滤列的值。 将值分配给一个数组，然后将该数组的元素数作为filter应用于该列，同时包含您希望过滤的新值。 编辑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：

 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 

希望这可以帮助。