Приведенный ниже код должен помочь вам начать. Если у вас есть какие-либо вопросы, просто кричите.

ель - отфильтровать сводную таблицу, используя диапазон на другом листе. Этот диапазон извлекает данные с 3-го листа, который представляет собой дамп данных, который отбирает целый ряд формул и изменяется каждый раз, когда он используется.

У меня есть код ниже, но я вижу, как он выполняет все поля сводной таблицы, сравнивает его с диапазоном и затем удаляет фильтр. У меня есть 32 000 полей, которые необходимо проверить, чтобы текущий макрос был слишком медленным для использования.

Может ли кто-нибудь помочь мне исправить код, чтобы он фильтровал только по значениям в диапазоне, которые не являются пустыми?

Sub PT()
Dim PT As PivotTable
Dim PI As PivotItem
Set PT = Sheets("Pivot_Sheet").PivotTables("PivotTable2")
With Sheets("Pivot_Sheet").PivotTables("PivotTable2").PivotFields("Product")
.ClearAllFilters
End With
For Each PI In PT.PivotFields("Product").PivotItems
PI.Visible = WorksheetFunction.CountIf(Sheets("Sheet1").Range("J2:J100"),
PI.Name) > 0
Next PI
Set PT = Nothing
End Sub
 NMO29 сент. 2017 г., 13:13
Извините, код помечен.
 Sand29 сент. 2017 г., 12:46
Поместите свой код в теги кода, пожалуйста.

Ответы на вопрос(1)

Решение Вопроса

пост на эту тему если вам интересно узнать о узких местах, которых следует избегать при фильтрации сводных таблиц.

Приведенный ниже код должен помочь вам начать. Если у вас есть какие-либо вопросы, просто кричите.

Option Explicit

Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vList As Variant

Set pt = ActiveSheet.PivotTables("PivotTable2")
Set pf = pt.PivotFields("Product")

vList = Application.Transpose(ActiveWorkbook.Worksheets("Sheet1").Range("J2:J100"))

pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed

With pf

    'At least one item must remain visible in the PivotTable at all times, so make the first
    'item visible, and at the end of the routine, check if it actually  *should* be visible
    .PivotItems(1).Visible = True

    'Hide any other items that aren't already hidden.
    'Note that it is far quicker to check the status than to change it.
    ' So only hide each item if it isn't already hidden
    For i = 2 To .PivotItems.Count
        If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
    Next i

    'Make the PivotItems of interest visible
    On Error Resume Next 'In case one of the items isn't found
    For Each vItem In vList
        .PivotItems(vItem).Visible = True
    Next vItem
    On Error GoTo 0

    'Hide the first PivotItem, unless it is one of the items of interest
    On Error Resume Next
    If InStr(UCase(Join(vList, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
    If Err.Number <> 0 Then
        .ClearAllFilters
        MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
    End If
    On Error GoTo 0

End With

pt.ManualUpdate = False

End Sub

Ваш ответ на вопрос