excel vba：为sheet2创buildfilter，将数据从应用于sheet1的filter中获取

所以我对excel和VBA很不熟悉，但在过去的几个星期里试图挖掘它。 我需要为包含相同数据（和列）的多个工作表设置filter。 为了在多个工作表中筛选相同的范围，我已经find一个简单的解决scheme：

Sub apply_autofilter_across_worksheets() Dim p As Integer, q As Integer p = Worksheets.Count For q = 1 To p With Worksheets(q) .AutoFilterMode = False .Range("A1").AutoFilter .Range("A1").AutoFilter Field:=1, Criteria1:="2" End With Next q End Sub 

真正的麻烦从这里开始：我想在表1到第2列中设置一个filter，从第1列获取结果数据并将其用作表2的过滤条件（最终是3）。 床单看起来像这样：

工作表Sheet1

 | itemgroup | subject | course | 1 | biology | B.Sc. | 1 | chemistry| B.Sc. | 1 | history | M.Sc. | 2 | biology | B.Sc. | 2 | history | B.Sc. | 3 | chemistry| B.Sc. 

Sheet2中

 | itemgroup | items | 1 | Example | 1 | Example | 2 | Example | 3 | Example 

例如，我想在表单1中设置为filter“生物学”，然后在表单2中为第1列设置“1”和“2”作为filter。
我已经使用下面的代码。 filter设置为两个工作表，但工作表2仅由一个条件过滤。 结果如下所示：

应用滤波器后的Sheet2

这是我将filter应用到的数据： https ： //drive.google.com/open？id = 0B6wLL0wGBKsNWHJ3bDYtdVd0cEE

我使用的代码：

 Option Explicit Sub main() Dim cell As Range, filtValuesRng As Range With Worksheets("Itemgruppen") '<--| reference worksheet "Sheet1" With .Range("A1").CurrentRegion '<-- reference its data set .AutoFilter 2, "Biologie" '<--| filter it on column 2 with criteria="biology" If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then Set filtValuesRng = .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) '<--| if any value filtered then set them into a range End With '.AutoFilterMode = False '<--| show all rows back and remove filters End With If filtValuesRng Is Nothing Then Exit Sub '<--| if no values filtered from previous "Sheet1" column 2 filtering then exit With Worksheets("Itembloecke") '<--| reference worksheet "Sheet2" With .Range("A1").CurrentRegion '<-- reference its data set For Each cell In filtValuesRng '<--| iterate over "Sheet1" column filtered values .AutoFilter 1, cell.Value2 '<--| filter worksheet "Sheet2" dataset on column 1 with current "Sheet1" column filtered value If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... ' .SpecialCells(xlCellTypeVisible)... '<--| do something with filtered cells End If Next End With '.AutoFilterMode = False '<--| show all rows back and remove filters End With End Sub 

这是我的第一个关于堆栈溢出的问题 – 如果您对如何更好地提出问题有任何build议，我会很感激。

Answer 1

你可以试试这个（注释）代码：

 Option Explicit Sub main() Dim cell As Range, filtValuesRng As Range With Worksheets("Sheet1") '<--| reference worksheet "Sheet1" With .Range("A1").CurrentRegion '<-- reference its data set .AutoFilter 2, "biology" '<--| filter it on column 2 with criteria="biology" If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then Set filtValuesRng = .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) '<--| if any value filtered then set them into a range End With .AutoFilterMode = False '<--| show all rows back and remove filters End With If filtValuesRng Is Nothing Then Exit Sub '<--| if no values filtered from previous "Sheet1" column 2 filtering then exit With Worksheets("Sheet2") '<--| reference worksheet "Sheet2" With .Range("A1").CurrentRegion '<-- reference its data set For Each cell In filtValuesRng '<--| iterate over "Sheet1" column filtered values .AutoFilter 1, cell.Value2 '<--| filter worksheet "Sheet2" dataset on column 1 with current "Sheet1" column filtered value If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... ' .SpecialCells(xlCellTypeVisible)... '<--| do something with filtered cells End If Next End With .AutoFilterMode = False '<--| show all rows back and remove filters End With End Sub 

Answer 2

这是否解决您的问题？

 Sub apply_autofilter_across_worksheets() Dim sht As Worksheet For Each sht In ThisWorkbook.Worksheets ' loop over all sheets sht.AutoFilterMode = False ' remove current filter sht.Range("A1").AutoFilter ' add new filter If sht.Name = "Sheet1" Then ' specifics for Sheet1 sht.Range("A1").AutoFilter _ ' specify the options for the filter Field:=2, _ ' add criteria to second column Criteria1:="biology" End If If sht.Name = "Sheet2" Then ' specifics for Sheet2 sht.Range("A1").AutoFilter _ ' specify the options for the filter Field:=1, _ ' add criteria to first column Criteria1:=Array("1", "2"), Operator:=xlFilterValues ' add multiple criterias End If Next sht End Sub