Excel VBA filter CritiriaRange

Question

我想从工作表中筛选2列(B和C(，并为此创建了代码，但希望更容易更改筛选条件。

我创建的是：

Sub test()
Application.DisplayAlerts = False
Dim Mh As String
Mh = ActiveSheet.Name 'Month name
'Add en Rename ActiveSheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Test " & Mh
'Filter Ranges
Range("A1").Select
Sheets("October").Range("A1:F999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Filters").Range("A1:B2"), CopyToRange:=Range("A1:F1"), Unique:=False
End Sub

我想要的是这样的东西，以便能够更改过滤器名称：

ActiveSheet.Range("A2:F999").AutoFilter Field:=2, Criteria1:="WABO"
ActiveSheet.Range("A2:F999").AutoFilter Field:=3, Criteria1:="Zuid"

Answer 1

筛选器组合

一个月后你会收到一张单子。您将新的工作表添加到上一个位置并重命名它。现在您可以用Sheets(Sheets.Count)、Sheets("Test " & Mh)或ActiveSheet来引用它。我选择了第一条路。然后，将初始图纸中经过特定过滤的范围(图纸Filters中的过滤器(复制到新图纸中。您在范围上应用另外2个过滤器。

Sub test()
Const cStr2 = "WABO"
Const cStr3 = "Zuid"
Application.DisplayAlerts = False
Dim Mh As String
Mh = ActiveSheet.Name 'Month name
'Add and Rename ActiveSheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Test " & Mh
With Sheets(Sheets.Count)
'Filter Ranges
Sheets(Mh).Range("A1:F999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Filters").Range("A1:B2"), _
CopyToRange:=.Range("A1:F1")
.Range("A2:F999").AutoFilter Field:=2, Criteria1:=cStr2
.Range("A2:F999").AutoFilter Field:=3, Criteria1:=cStr3
End With
Application.DisplayAlerts = True
End Sub