Объединить раскрывающиеся критерии для фильтрации данных VBA

Question

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

Таблица данных

Private Sub Worksheet_Change(ByVal Target As Range)


'Year Criteria
If Target.Address = "$C$1" Then
    If Target.Value = "All" Then
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=1
    Else
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=1, Criteria1:=Target.Value
    End If

'Tournament Criteria
ElseIf Target.Address = "$C$2" Then
    If Target.Value = "All" Then
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=3
    Else
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=3, Criteria1:=Target.Value
    End If

'Week Criteria 1
ElseIf Target.Address = "$C$3" Then
    If Target.Value = "All" Then
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2
    Else
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
    End If

'Week Criteria 2
ElseIf Target.Address = "$C$4" Then
    If Target.Value = "All" Then
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2
    Else
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
    End If

'Week Criteria 3
ElseIf Target.Address = "$C$5" Then
    If Target.Value = "All" Then
       Worksheets("Ark1").ListObjects("Tabek1").Range.AutoFilter Field:=2
    Else
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
    End If

'Week Criteria 4
ElseIf Target.Address = "$C$6" Then
    If Target.Value = "All" Then
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2
    Else
       Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
    End If

End If

End Sub

Answer 1

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

Sub autofilter_range()
Dim filtur(1 To 4) As Variant
filtur(1) = "1"
filtur(3) = "3"
Sheet1.Range("A1:C7").AutoFilter field:=2, Criteria1:=filtur, Operator:=xlFilterValues
End Sub

Это создаст массив снедели с 1 по 4, затем добавляет значения в соответствующие позиции в массиве.(1 и 3 в этом случае) Затем он применяет автофильтр только с этими неделями.

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

If Sheets("Sheet1").CheckBox1.Value = True Then filtur(1) = "1"

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