Цикл по каждой ячейке, и, если совпадение, захватить значение и добавить в список / массив, который будет использовать его для автофильтра

Question

Самоочевидный предмет. Проблема, с которой я сталкиваюсь сейчас, заключается в том, что мой exrcif не увеличивается, поскольку я хотел бы включить список критериев в автофильтр.

В настоящее время у меня есть этот код:

    Dim oneCell as Range
    Dim exrcif as String

    For each oneCell in Range(“H2:H1000”)    
        With oneCell    
            If oneCell.value = 0 Then    
                exrcif = oneCell.Offset(,-7).Value    
                Exit For
            End If
        End With
    Next oneCell

    Range(“A:H”).AutoFilter Field:=4, , Criteria1:=exrcif
End sub

Answer 1

Проблема, с которой вы столкнулись, заключается в том, что ваш exrcif является String и не содержит массив, а

exrcif = oneCell.Offset(,-7).Value 

перезаписывает эту строку в каждой итерации. Вместо этого вы должны добавить значение в массив:

Например, написать процедуру для добавления значения в массив

Option Explicit

Public Sub AppendToArray(ByRef Arr() As Variant, ByVal AppendValue As Variant)
    Dim ArrSize As Long
    ArrSize = -1

    On Error Resume Next
    ArrSize = UBound(Arr)
    On Error GoTo 0

    ReDim Preserve Arr(ArrSize + 1)
    Arr(ArrSize + 1) = AppendValue
End Sub

и использовать его, как показано ниже

Public Sub test()
    Dim exrcif() As Variant

    Dim oneCell As Range
    For Each oneCell In Range("H2:H1000")
        If oneCell.Value = 0 Then
            AppendToArray Arr:=exrcif, AppendValue:=oneCell.Offset(, -7).Value
            'note no Exit For here! Otherwise it will stop after the first found 0
        End If
    Next oneCell

    Range("A:H").AutoFilter Field:=4, Criteria1:=exrcif, Operator:=xlFilterValues
End Sub

Answer 2

вариант с использованием Scripting.Dictionary

Sub test()
    Dim oneCell As Range
    Dim exrcif As Object: Set exrcif = CreateObject("Scripting.Dictionary")
    For Each oneCell In Range("H2:H1000")
        With oneCell
            If oneCell.Value = 0 And _
                oneCell.Value <> "" And _
                Not exrcif.exists(oneCell.Offset(, -7).Value) Then
                exrcif.Add oneCell.Offset(, -7).Value, Nothing
            End If
        End With
    Next oneCell
    Range("A:H").AutoFilter Field:=4, Criteria1:=exrcif.Keys, Operator:=xlFilterValues
End Sub

тест: