When automatically adjusting filters, ignore filters that are outside the scope or not present

问题

I built a macro to extract certain columns from a closed workbook and paste them in a worksheet. That sheet is then used to create pivot tables and futher used with vlookup functions. The only problem I have is filters. There are 2 users of the data that are assigned different variables in a filter. Adding to that, the variables in the filter can change. Although the users need the same filters, some of the filters assigned to the user may be not be present in all the files they are extracting. I have written code that will filter the pivot tables but it will not work if new filters are added or if an assigned filter is not present in the file to extract. How would I fix this code to ignore filters outside the users assigned variables in the filter and also ignore if one or some of the assigned variables are not in the filter.

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:

It would be better to move the hide/show to a different sub to reduce your main code size and abstract out the common task:

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

来源：https://stackoverflow.com/questions/56118811/when-automatically-adjusting-filters-ignore-filters-that-are-outside-the-scope

标签

excel

vba

extract