vba 选择/取消选择所有枢轴项

Select/Deselect all Pivot Items

提问by WJol

I have a pivot table, and I am trying to select certain pivot items based on values in an array. I need this process to go faster, so I have tried using Application.Calculation = xlCalculationManualand PivotTables.ManualUpdate = True, but neither seem to be working; the pivot table still recalculates each time I change a pivot item.

我有一个数据透视表，我试图根据数组中的值选择某些数据透视项。我需要这个过程更快，所以我尝试使用Application.Calculation = xlCalculationManualand PivotTables.ManualUpdate = True，但似乎都不起作用；每次更改数据透视表时，数据透视表仍会重新计算。

Is there something I can do differently to prevent Excel from recalculating each time? Or is there a way to deselect all items at once (not individually) to make the process go quicker?

有什么我可以做的不同的事情来防止 Excel 每次都重新计算吗？或者有没有办法一次（而不是单独）取消选择所有项目以使过程更快？

Here is my code:

这是我的代码：

Application.Calculation = xlCalculationManual

'code to fill array with list of companies goes here    

Dim PT As Excel.PivotTable
Set PT = Sheets("LE Pivot Table").PivotTables("PivotTable1")

Sheets("LE Pivot Table").PivotTables("PivotTable1").ManualUpdate = True
Dim pivItem As PivotItem

'compare pivot items to array.  
'If pivot item matches an element of the array, make it visible=true, 
'otherwise, make it visible=false
For Each pivItem In PT.PivotFields("company").PivotItems
    pivItem.Visible = False 'initially make item unchecked
    For Each company In ArrayOfCompanies()
        If pivItem.Value = company Then
            pivItem.Visible = True
        End If
    Next company
Next pivItem

回答by EEM

It seems unavoidable to have the pivotable refreshed every time a pivotitem is updated. However I tried approaching the problem from the opposite angle. i.e.:

每次更新枢轴项时都刷新枢轴项似乎是不可避免的。但是，我尝试从相反的角度解决问题。IE：

1.Validating the “PivotItems to be hidden”before updating the pivottable.

1.在更新数据透视表之前验证“要隐藏的数据透视项”。

2.Also making make all items visible at once instead of “initially make item unchecked” one by one.

2.同时使所有项目都可见，而不是一一“最初使项目取消选中”。

3.Then hiding all the items not selected by the user (PivotItems to be hidden)

3.然后隐藏用户未选择的所有项目（要隐藏的PivotItems）

I ran a test with 6 companies selected out of a total of 11 and the pivottable was updated 7 times

我从总共 11 家公司中选出了 6 家公司进行了测试，数据透视表更新了 7 次

Ran also your original code with the same situation and the pivottable was updated 16 times Find below the code

在相同情况下也运行您的原始代码，并且数据透视表更新了 16 次 在代码下方找到

Sub Ptb_ShowPivotItems(aPtbItmSelection As Variant)

Dim oPtb As PivotTable
Dim oPtbItm As PivotItem
Dim aPtbItms() As PivotItem
Dim vPtbItm As Variant
Dim bPtbItm As Boolean
Dim bCnt As Byte

    Set oPtb = ActiveSheet.PivotTables(1)

    bCnt = 0
    With oPtb.PivotFields("Company")

        ReDim Preserve aPtbItms(.PivotItems.Count)
        For Each oPtbItm In .PivotItems

            bPtbItm = False
            For Each vPtbItm In aPtbItmSelection
                If oPtbItm.Name = vPtbItm Then
                    bPtbItm = True
                    Exit For
            End If: Next

            If Not (bPtbItm) Then
                bCnt = 1 + bCnt
                Set aPtbItms(bCnt) = oPtbItm
            End If

        Next
        ReDim Preserve aPtbItms(bCnt)

        .ClearAllFilters
        For Each vPtbItm In aPtbItms
            vPtbItm.Visible = False
        Next

    End With

End Sub

回答by EEM

It seems that you really want to try something different to significantly reduce the time it takes to select the required items in pivotttable. I propose to use a “MirrorField”, i.e. a copy of the “Company” to be used to set in the sourcedata of the pivottable the items you need to hide\show.

看来您真的想尝试一些不同的东西来显着减少在数据透视表中选择所需项目所需的时间。我建议使用“MirrorField”，即“公司”的副本，用于在数据透视表的源数据中设置您需要隐藏\显示的项目。

First you need to add manually (or programmatically) the “MirrorField” and named same as the source field with a special character at the beginning like “!Company” the item must be part of the sourcedata and it can be placed in any column of it (as this will a “programmer” field I would place it in the last column and probably hidden as to not creating any issues for\with the users)

首先，您需要手动（或以编程方式）添加“MirrorField”并命名为与源字段相同的名称，开头带有特殊字符，如“!Company”，该项目必须是源数据的一部分，并且可以放置在它（因为这将是一个“程序员”字段，我会将它放在最后一列中，并且可能会隐藏起来，以免为\与用户产生任何问题）

Please find below the code to update the pivottable datasource and to refresh the pivottable

请在下面找到更新数据透视表数据源和刷新数据透视表的代码

I'm also requesting the PivotField to be updated just make it flexible as it then can be used for any field (provided that the “FieldMirror” is already created) Last: In case you are running any events in the pivottable worksheet they should be disable and enable only to run with the last pivottable update

我还要求更新 PivotField 使其灵活，因为它可以用于任何字段（前提是已经创建了“FieldMirror”） 最后：如果您在数据透视表工作表中运行任何事件，它们应该是禁用和启用仅与上次数据透视表更新一起运行

Hope this is what you are looking for.

希望这是你正在寻找的。

Sub Ptb_ShowPivotItems_MirrorField(vPtbFld As Variant, aPtbItmSelection As Variant)
Dim oPtb As PivotTable
Dim rPtbSrc As Range
Dim iCol(2) As Integer
Dim sRC(2) As String
Dim sFmlR1C1 As String
Dim sPtbSrcDta As String

    Rem Set PivotTable & SourceData
    Set oPtb = ActiveSheet.PivotTables(1)
    sPtbSrcDta = Chr(34) & oPtb.SourceData & Chr(34)
    Set rPtbSrc = Evaluate("=INDIRECT(" & sPtbSrcDta & ",0)")

    Rem Get FieldMirrow Position in Pivottable SourceData (FieldMirrow Already present SourceData)
    With rPtbSrc
        iCol(1) = -1 + .Column + Application.Match(vPtbFld, .Rows(1), 0)
        iCol(2) = Application.Match("!" & vPtbFld, .Rows(1), 0)
    End With

    Rem Set FieldMirror Items PivotTable SourceData as per User Selection
    sRC(1) = """|""&RC" & iCol(1) & "&""|"""
    sRC(2) = """|" & Join(aPtbItmSelection, "|") & "|"""
    sFmlR1C1 = "=IF(ISERROR(SEARCH(" & sRC(1) & "," & sRC(2) & ")),""N/A"",""Show"")"
    With rPtbSrc.Offset(1).Resize(-1 + rPtbSrc.Rows.Count).Columns(iCol(2))
        .Value = "N/A"
        .FormulaR1C1 = sFmlR1C1
        .Value = .Value2
    End With

    Rem Refresh PivotTable & Select FieldMirror Items
    With oPtb

        Rem Optional: Disable Events - In case you are running any events in the pivottable worksheet
        Application.EnableEvents = False

        .ClearAllFilters
        .PivotCache.Refresh
        With .PivotFields("!" & vPtbFld)
            .Orientation = xlPageField
            .EnableMultiplePageItems = False

            Rem Optional: Enable Events - To triggrer the pivottable worksheet events only with last update
            Application.EnableEvents = True
            .CurrentPage = "Show"

    End With: End With

End Sub