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）的过滤条件。床单看起来像这样：

表格1

| 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.

表格2

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

例如，我想在 sheet1 中设置为过滤器“biology”，然后应将“1”和“2”设置为 sheet 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

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

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