Question

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

我是否可以采用不同的方式阻止Excel每次重新计算？或者有没有办法一次取消选择所有项目（而不是单独）以使过程更快？

这是我的代码：

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

Answer 1

每次更新pivotitem时，无法避免可循环刷新。但是我尝试从相反的角度解决问题。即：

1.在更新数据透视表之前，验证“PivotItems隐藏”。

2.还可以一次性显示所有项目，而不是“逐步使项目取消选中”。

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

我在总共11家公司中选出的6家公司进行了测试，并且数据库表更新了7次

同样的情况下，你的原始代码也是如此，并且枢轴表更新了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

Answer 2

您似乎真的想尝试不同的东西，以显着减少在可转换中选择所需项目所需的时间。我建议使用“MirrorField”，即“公司”的副本，用于在枢轴表的源数据中设置隐藏\ show所需的项目。

首先，您需要手动（或以编程方式）添加“MirrorField”并将其命名为source字段，并在开头添加特殊字符，如“！Company”，该项必须是sourcedata的一部分，并且可以放入它的任何一列（因为这将是一个“程序员”字段，我将它放在最后一列，并可能隐藏为不为用户创建\的任何问题）

请在下面找到更新数据透视表数据源并刷新数据透视表

的代码

我还要求更新PivotField，只是让它变得灵活，因为它可以用于任何字段（前提是已经创建了“FieldMirror”）最后一个：如果您在pivottable工作表中运行任何事件，则应禁用它们并仅启用最后一个pivottable更新

希望这就是你要找的东西。

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

选择/取消选择所有数据透视项目

2 个答案: