Цикл фильтра Excel VBA

Question

Есть предложения, как решить следующую проблему?У меня есть список из ~ 15 различных элементов, из которых только некоторые присутствуют в таблице (Excel 2016) в любой конкретный момент.

Я хочу использовать VBA для циклического прохождения существующего диапазона таблицы и фильтр на основе каждого отдельного элемента .Когда найден, я хочу запустить дополнительный код.

У меня нет проблем с простым кодом, чтобы найти и отфильтровать один жестко закодированный элемент, и, если он найден, запустить другой фрагмент кода и, если нет, выйти.Однако я считаю, что должен быть лучший вариант, так как планирование 15 различных сценариев для запуска очень неэффективно, и мне также нужно запускать их один за другим.

Любые предложения о том, как сделать это с 1 кодом, вместоиз 15 разных?

Фиктивная таблица, пожалуй, лучше объясняет - из 15 различных предметов в настоящее время она имеет 4 разных.Я хотел бы зациклить таблицу и отфильтровать каждый элемент отдельно и запустить код с каждым из них.

Это то, что я придумалс, но этот будет работать только в случае дублирования и запуска 15 раз с различными жестко закодированными критериями фильтрации:

Sub Filter_single ()

Dim Filtered as Range  
Set Filtered = Sheets("Sheet1").Range("Table1").SpecialCells(xlCellTypeVisible)

    With ActiveSheet.ListObjects("Table1").Range
        .AutoFilter Field:=1, Criteria1:="Apple"

    End With

If Filtered is Nothing Then
End If

... if range "Filtered" is not Nothing, run another code here...

End Sub

Answer 1

Вложите свой код в уникальный цикл значений.Я просто жестко запрограммировал значения Arr здесь, но вы можете загрузить это различными способами (все из которых хорошо документированы на этом сайте)

---

Sub Filter_single()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim Filtered As Range, i As Long, Arr

Arr = Array("Apple", "Orange", "Grape")

For i = LBound(Arr) To UBound(Arr)
    With ws.ListObjects("Table1").Range
        .AutoFilter Field:=1, Criteria1:="Apple"
        Set Filtered = .SpecialCells(xlCellTypeVisible)
    End With

    If Filtered.Rows.Count > 1 And Not Filtered Is Nothing Then
        'Run Macro Here
    End If

    Set Filtered = Nothing
Next i

End Sub