excel vba：为sheet2创建过滤器，并将数据从应用于sheet1的过滤器中取出

Question

所以我对excel和VBA非常不熟悉，但在过去的几周里试图深入研究它。我需要为包含相同数据（和列）的多个工作表设置一个过滤器。用于过滤在多张相同的范围内我已经发现了一个简单的解决方案：

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列，从第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 

比如我想在Sheet1设置为过滤器 “生物学”，然后选择 “1” 和“ 2“应设置为表2中第1列的过滤器。
我已使用下面的代码。过滤器被设置为两个工作表，但工作表2仅被一个标准过滤。结果是这样的：

Sheet2 after Filter applied

这是数据我应用过滤器：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 

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

Answer 1

这是否解决您的问题？

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 

Answer 2

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

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