自动调整过滤器时，请忽略超出范围或不存在的过滤器

问题描述

限时删除！！

我构建了一个宏，用于从关闭的工作簿中提取某些列并将其粘贴到工作表中.然后，该工作表用于创建数据透视表，并进一步与vlookup函数一起使用.我唯一的问题是过滤器.数据的两个用户在过滤器中分配了不同的变量.除此之外，过滤器中的变量可以更改.尽管用户需要相同的过滤器，但是分配给用户的某些过滤器可能并不存在于他们提取的所有文件中.我已经编写了可以过滤数据透视表的代码，但是如果添加了新的过滤器或者要提取的文件中没有指定的过滤器，它将无法正常工作.我将如何解决此代码，以忽略过滤器中用户分配的变量之外的过滤器，以及是否忽略分配器中的一个或某些分配变量.

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

推荐答案

最好将隐藏/显示移动到其他子目录，以减小您的主要代码大小并抽象出常见任务:

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

这篇关于自动调整过滤器时，请忽略超出范围或不存在的过滤器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！

1403页，肝出来的..