如何在vba中为两个具有两个不同标准的字段连续自动过滤？

Question

搜索1

继续搜索2

用于执行自动过滤操作的搜索按钮

Private Sub CommandButton1_Click() 'Search button
    Dim rData  As Range

    With Sheet1

        Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 8).End(xlUp))

        If Not .AutoFilterMode Then .Cells(1, 1).AutoFilter
        .Cells(1, 1).AutoFilter Field:=lFld, Criteria1:=sCrit            
        'Header
        On Error Resume Next
        Set rSource = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

        ActiveSheet.AutoFilterMode = False

        On Error GoTo 0
        .Cells(1, 200).CurrentRegion.ClearContents
        rSource.Copy .Cells(1, 200)

        Set rSource = .Cells(2, 200).CurrentRegion
        Set rSource = rSource.Offset(1, 0).Resize(rSource.Rows.Count - 1, _
                                                  rSource.Columns.Count)
    End With

    With Me.ListBox1
        .RowSource = ""
        .RowSource = rSource.Address(external:=True)
    End With

End Sub

如果我一次在一个字段和一个标准中自动过滤它们，它们就能完美地工作。 现在我的问题是如何自动过滤选项按钮然后继续并过滤组合框的数据？

编辑：我的列表框似乎在搜索后没有相应地使用excel更新2.我如何修改我的代码，使其从第一次搜索刷新并列出更新的搜索2结果？请指教。

Answer 1

如果您不关闭现有过滤器（例如通过调用ActiveSheet.AutoFilterMode = False），则设置AutoFilter（针对其他字段）将添加到任何现有过滤器而不是替换它。例如：

ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=4, Criteria1:="1"
ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=1, Criteria1:="DEF"

仅显示第1列包含DEF且第4列包含1的结果。

但是，如果您为同一字段再次设置自动筛选，则将替换该设置，例如：

ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=1, Criteria1:="ABC"
ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=1, Criteria1:="DEF"

仅显示第1列包含DEF的结果。

Answer 2

如评论所述，这样的事情可能有效：

With Sheet1
    Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 8).End(xlUp))
    .AutoFilterMode  = False
    '~~> you are filtering rData right? so work on it directly.
    rData.AutoFilter lFld, sCrit 

    'Header
    On Error Resume Next
    Set rSource = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    .AutoFilterMode = False
    On Error GoTo 0

    '~~> Use Sheet2 here or a temporary sheet for listbox display purpose only
    Sheet2.Cells.ClearContents
    rSource.Copy Sheet2.Cells(1, 1)

    Set rSource = Sheet2.Range(Sheet2.Cells(1, 1) _
                    , Sheet2.Cells(Sheet2.Rows.Count, 8).End(xlUp))
    Set rSource = rSource.Offset(1, 0).Resize(rSource.Rows.Count - 1, _
                                              rSource.Columns.Count)
End With

DoEvents '~~> Again this is a must to visually update ListBox display
Me.ListBox1.RowSource = rSource.Address(external:=True)

我更改了代码的某些部分，使其适用于实际对象 如链接中所述Avoid using Activesheet 另外，我很乐意定义实际范围，而不是使用 CurrentRegion 或 UsedRange 。