2015-07-14 12 views
1

У меня есть пользовательская форма, в которой пользователь будет проверять все элементы, на которые они хотят отфильтровать группу сводных таблиц. Проблема в том, что у меня около 40 сводных таблиц и более 250 опций, на которые пользователь может фильтровать. В идеале я планировал установить фильтр сводной таблицы на массив значений, но я не могу найти решение, которое позволяет избежать циклического перехода через параметры массива и фильтра. Пожалуйста, найдите мой код ниже. Любые рекомендации по оптимизации приветствуются. Спасибо!Оптимизация фильтра сводной таблицы Excel с использованием массива VBA

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 
+1

Что случилось с петлей? Или, почему вы пытаетесь оптимизировать этот код? Я подозреваю, что реальная проблема - это 40 сводных таблиц с 250 вариантами. –

+0

Привет, Брайон, да, я согласен, что проблема - это количество. Этот код работает быстро, когда количество сводных таблиц и количество опций ограничено. Хотя это может быть невозможно, мне было интересно, есть ли способ установить фильтр каждой сводной таблицы с одной строкой, как вы можете сделать с столбцом. – Alexis

+1

Это можно сделать, если поля заданы как 'OLAP', используя' PivotField.VisibleItemsList'. Не уверен, что это быстрее. Если вы хотите попробовать это, используйте параметр «Модель данных» в сводных таблицах. Я подозреваю, что может потребоваться преобразование всех таблиц. –

ответ

2

Я в конечном итоге фильтрации исходный набор данных, основанных на моем массиве и копировании и вставке этих отфильтрованных значений в новую таблицу на другой листе. Этот новый лист стал исходным данным для моих 40 сводных таблиц. Это изменение создало несколько меньших проблем, но теперь код работает в < 10 секунд по сравнению с 90 секундами. Спасибо всем, кто представил предложения по этому вопросу.

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 
Смежные вопросы