excel 加快向切片器VBA添加/删除数据透视表的速度

c6ubokkw 于 2023-05-30 发布在其他

关注(0)|答案(1)|浏览(159)

此bounty已结束。此问题的答案有资格获得+50声望奖励。赏金宽限期两小时后结束。bigsim希望引起更多关注这个问题。

我有一个工作簿，其中有许多数据透视表分布在许多工作表中。其中一个工作表上有一堆切片器，在更改过滤器/选择后加载它们非常慢。
我所有的切片器都在同一个工作表上（称之为Sheet 1），但15个透视表中只有4个在该工作表上。我想在激活Sheet 1时从切片器中删除不在同一个工作表中的其余11个数据透视表，并在停用Sheet 1时再次将其添加回来，以尝试提高性能。我已经写了一些代码来实现这一点，但目前它非常慢-运行大约需要一分钟（当我选择/取消选择工作表时），但切片器的加速只有1秒而不是6秒。有什么办法能加快我的进度吗？TIA！

Private Sub Worksheet_Deactivate()

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    pts = Array( _
        Worksheets("Sheet1").PivotTables("Pivot1"), _
        Worksheets("Sheet1").PivotTables("Pivot2"), _
        Worksheets("Sheet1").PivotTables("Pivot3"), _
        Worksheets("Sheet1").PivotTables("Pivot4"), _
        Worksheets("Sheet2").PivotTables("Pivot5"), _
        Worksheets("Sheet2").PivotTables("Pivot6"), _
        Worksheets("Sheet3").PivotTables("Pivot7"), _
        Worksheets("Sheet4").PivotTables("Pivot8"), _
        Worksheets("Sheet5").PivotTables("Pivot9"), _
        Worksheets("Sheet6").PivotTables("Pivot10"), _
        Worksheets("Sheet7").PivotTables("Pivot11"), _
        Worksheets("Sheet7").PivotTables("Pivot12"), _
        Worksheets("Sheet7").PivotTables("Pivot13"), _
        Worksheets("Sheet7").PivotTables("Pivot14"), _
        Worksheets("Sheet7").PivotTables("Pivot15") _
    )
    ss = Array( _
        ActiveWorkbook.SlicerCaches("Slicer1"), _
        ActiveWorkbook.SlicerCaches("Slicer2"), _
        ActiveWorkbook.SlicerCaches("Slicer3"), _
        ActiveWorkbook.SlicerCaches("Slicer4") _
    )
    For Each pt In pts
        For Each s In ss
            s.PivotTables.RemovePivotTable (pt)
        Next s
    Next pt
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = True
        
End Sub

excel

来源：https://stackoverflow.com/questions/76286968/speeding-up-add-remove-pivottable-to-slicer-vba

1条答案

按热度按时间

5vf7fwbs1#

尝试这个修改并检查它是否是你所需要的。

Private Sub Worksheet_Deactivate()

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim sc As SlicerCache
    
    ' Store the worksheet names and pivot table names in an array
    Dim wsNames As Variant
    wsNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet7", "Sheet7", "Sheet7", "Sheet7", "Sheet7")
    
    Dim ptNames As Variant
    ptNames = Array("Pivot1", "Pivot2", "Pivot3", "Pivot4", "Pivot5", "Pivot6", "Pivot7", "Pivot8", "Pivot9", "Pivot10", "Pivot11", "Pivot12", "Pivot13", "Pivot14", "Pivot15")
    
    ' Loop through each worksheet and pivot table
    For i = LBound(wsNames) To UBound(wsNames)
        Set ws = ThisWorkbook.Worksheets(wsNames(i))
        Set pt = ws.PivotTables(ptNames(i))
        
        ' Loop through each slicer cache and remove the pivot table
        For Each sc In ThisWorkbook.SlicerCaches
            sc.PivotTables.RemovePivotTable pt
        Next sc
    Next i
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub

赞(0）回复(0）举报 2023-05-30

我来回答

excel 加快向切片器VBA添加/删除数据透视表的速度

1条答案

相关问题

热门标签

最新问答