使用数组VBA优化Excel数据透视表filter

我有一个用户表单，其中用户将检查所有项目，他们希望一组数据透视表过滤。 问题是我有大约40个数据透视表和超过250个选项，用户可以过滤。 理想情况下，我计划将数据透视表filter设置为一个值的数组，但我找不到一个解决scheme，避免循环数组和filter选项。 请在下面find我的代码。 任何优化build议非常感谢。 谢谢！

Private Sub Filter_btn_Click() Dim i As Integer Dim n As Integer Dim filter_num As Integer Dim pivot_num As Integer Dim MyArray() As String Dim pt As PivotTable Application.ScreenUpdating = False Set dashboard = Sheets("Dashboard") 'Adding all selected items to array n = 0 For i = 0 To Supplier_Listbox.ListCount - 1 If Supplier_Listbox.Selected(i) = True Then ReDim Preserve MyArray(n) MyArray(n) = Supplier_Listbox.List(i) n = n + 1 End If Next i = 0 For pivot_num = 1 To 41 Set pt = dashboard.PivotTables("PivotTable" & pivot_num) filter_num = 0 With pt.PivotFields("FilterItems") 'Include first item in filter to avoid error .PivotItems(1).Visible = True ' PivotItems.Count is 270 For i = 2 To .PivotItems.Count ' Attempted to make the code a little faster with first if statement. Will avoid function if all array items have been checked If filter_num = n Then .PivotItems(i).Visible = False ' Call to function ElseIf IsInArray(.PivotItems(i), MyArray) Then .PivotItems(i).Visible = True filter_num = filter_num + 1 Else: .PivotItems(i).Visible = False End If Next 'Check if first item is actually in array, if not, remove filter If IsInArray(.PivotItems(1), MyArray) Then .PivotItems(1).Visible = True Else: .PivotItems(1).Visible = False End If End With Next Unload Me Application.ScreenUpdating = True End Sub 

Answer 1

我结束了根据我的数组过滤原始数据集，并将这些过滤的值复制粘贴到另一个表上的新表。 这个新表成为我的40个数据透视表的源数据。 这个更改创造了几个较小的问题，但是现在代码运行时间<10秒，而90秒。 感谢大家提出了这个问题的build议。

 Private Sub Filter_btn_Click() Dim i As Integer Dim n As Integer Dim MyArray() As String Application.ScreenUpdating = False Set dashboard = Sheets("Dashboard") Set Org_data = Sheets("Original Data") Set Filtered_Data = Sheets("Filtered Data") 'Adding all selected items in userform to array n = 0 For i = 0 To FilterOptions_Listbox.ListCount - 1 If FilterOptions_Listbox.Selected(i) = True Then ReDim Preserve MyArray(n) MyArray(n) = FilterOptions_Listbox.List(i) n = n + 1 End If Next Filtered_Data.Activate ActiveSheet.ListObjects("Table2").DataBodyRange.Select Selection.ClearContents 'Copy values filtered on array Org_data.Activate Org_data.ShowAllData With Org_data.Range("A1") .AutoFilter Field:=2, Criteria1:=MyArray, Operator:=xlFilterValues End With ActiveSheet.ListObjects("Table1").DataBodyRange.Select Selection.Copy 'Paste filtered values Filtered_Data.Activate ActiveSheet.ListObjects("Table2").DataBodyRange.Select Selection.PasteSpecial xlPasteValues Application.CutCopyMode = False 'Refresh all pivot tables at once ActiveWorkbook.RefreshAll dashboard.Activate Application.ScreenUpdating = True Unload Me End Sub