При автоматической настройке фильтров игнорируйте фильтры, которые находятся вне области действия или отсутствуют - PullRequest
Новая
       8

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

0 голосов
/ 13 мая 2019

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

Private Sub CommandButton1_Click()
Worksheets("Totals").Range("G1") = TextBox2.Value
Worksheets("Totals").Range("C1") = TextBox1.Value
If ComboBox1 = "3" Then
  Sheets("BPAR").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC"). _
    CurrentPage = "(All)"
 With ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC")
    .PivotItems("4").Visible = False
    .PivotItems("12").Visible = False
    End With
Sheets("BCOP").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC"). _
    CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC")
    .PivotItems("4").Visible = False
    .PivotItems("12").Visible = False
End With
      ActiveWorkbook.RefreshAll
    Else
Sheets("BPAR").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC"). _
    CurrentPage = "(All)"
 With ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC")
    .PivotItems("4").Visible = True
    .PivotItems("12").Visible = True
    End With
Sheets("BCOP").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC"). _
    CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("FAC")
    .PivotItems("4").Visible = True
    .PivotItems("12").Visible = True
End With
      ActiveWorkbook.RefreshAll
End If


ActiveWorkbook.RefreshAll
Unload Me
End Sub

1 Ответ

1 голос
/ 16 мая 2019

Было бы лучше переместить скрыть / показать в другую подпрограмму, чтобы уменьшить размер основного кода и абстрагироваться от общей задачи: 

Private Sub CommandButton1_Click()

    Dim sht As Worksheet, pflds As PivotFields, showItems As Boolean
    Dim arr

    With Worksheets("Totals")
        .Range("G1").Value = TextBox2.Value
        .Range("C1").Value = TextBox1.Value
    End With

    arr = split(ComboBox1,",") '<<< make an array from the combobox value

    'show only the values in arr for specific pivot fields
    ShowOnlyThese Sheets("BPAR").PivotTables("PivotTable1").PivotFields("FAC"), arr

    ShowOnlyThese Sheets("BCOP").PivotTables("PivotTable1").PivotFields("FAC"), arr

    ActiveWorkbook.RefreshAll
    Unload Me

End Sub

'loop over all items in a pivotfield "pf", and show only those matching a value in "arrItems"
Sub ShowOnlyThese(pf As PivotField, arrItems)
    Dim pi As PivotItem, haveOne As Boolean
    For Each pi In pf.PivotItems
        On Error Resume Next
        'this *could* throw an error if you're trying to hide the last item
        '  since there must be at least one item visible...
        pi.Visible = Not IsError(Application.Match(pi.Value, arrItems, 0))
        On Error GoTo 0
    Next pi
End Sub
...