基于可变条件的自动筛选

Question

Since i'm new to VBA coding i'm tring to write a code that filter data based on variable cells comes from another filter in the same sheet, but keep replyig with the first value only of the selected criteria, any suggestions?

Sub FilterCriteria()
Dim vCrit As Variant
Dim wsO As Worksheet
Dim wsL As Worksheet

Dim rngOrders As Range
Set wsO = Worksheets("Orders")
Set wsL = Worksheets("Lists")
Set rngOrders = wsO.Range("$A$1").CurrentRegion

rngOrders.AutoFilter _
Field:=6, Criteria1:=Array("51", "55", "71"), _
Operator:=xlFilterValues


Dim rngCrit As Range
Set rngCrit = wsO.Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

rngOrders.AutoFilter Field:=6 'To remove other filter to be able to look up in the whole sheet

vCrit = rngCrit.Value

rngOrders.AutoFilter _
    Field:=4, _
    Criteria1:=Application.Transpose(vCrit), _
    Operator:=xlFilterValues

End Sub

Answer 1

You have to set the filtered range to visible cells only using .SpecialCells(xlCellTypeVisible) but that can give you a non-contiguous range like $D$1:$D$2,$D$6,$D$9 with multiple areas which needs to be treated differently to a contiguous range like $DS1:$D$9. One way would be to loop through the cells in that range and build an array for the 2nd filter. For example

Option Explicit

Sub FilterCriteria()
    Dim vCrit As Variant
    Dim wsO As Worksheet
    Dim wsL As Worksheet

    Dim rngOrders As Range
    Set wsO = Worksheets("Orders")
    Set wsL = Worksheets("Lists")
    Set rngOrders = wsO.Range("$A$1").CurrentRegion

    Dim rng As Range
    rngOrders.AutoFilter _
        Field:=6, Criteria1:=Array("51", "55", "71"), _
        Operator:=xlFilterValues
    Set rng = rngOrders.Columns(4).SpecialCells(xlCellTypeVisible)
    'Debug.Print rng.Address

    Dim arr() As String, cell As Range, i As Integer
    If rng.Cells.Count > 2 Then
        ReDim arr(rng.Cells.Count - 2)
    Else 
        ReDim arr(0)
    End If

    i = 0

    ' build array
    For Each cell In rng
       If i > 0 Then ' skip header
           arr(i - 1) = cell.Value
       End If
       i = i + 1
    Next
    'Debug.Print Join(arr, ",")

    rngOrders.AutoFilter Field:=6 'To remove other filter to be able to look up in the whole sheet
    rngOrders.AutoFilter _
        Field:=4, _
        Criteria1:=arr, _
        Operator:=xlFilterValues

End Sub