Обновление сводных таблиц с помощью слайсеров - PullRequest
Новая
       37

Обновление сводных таблиц с помощью слайсеров

0 голосов
/ 19 июня 2020

У меня есть книга со сводными таблицами и сводными диаграммами со связанными срезами. Я написал код для обновления sh данных, но он немного медленный, поэтому мне было интересно, есть ли лучший подход, который мне не хватает. (Это не очень медленно, но я осознаю, что чем больше я добавляю к нему, тем медленнее он может стать ...) добавление слайсеров. Вот мой код: 

    Sub RefreshPvts()

Dim PvtWB As Workbook:              Set PvtWB = ActiveWorkbook
Dim DataWS As Worksheet:            Set DataWS = PvtWB.Sheets("Data Inputs")
Dim PivotWS As Worksheet:           Set PivotWS = PvtWB.Sheets("Look-thru Report")
Dim PieChtWS As Worksheet:          Set PieChtWS = PvtWB.Sheets("Piechart Data")

Dim PvtRng As Range
Dim LRow As Long

Dim UnderlyingPvt As PivotTable:    Set UnderlyingPvt = PivotWS.PivotTables("PvtUnderlying")
Dim TotalPvt As PivotTable:           Set TotalPvt = PivotWS.PivotTables("PvtChartTotal")
Dim PiePvtCountry As PivotTable:    Set PiePvtCountry = PieChtWS.PivotTables("PieChartCountry")
Dim PiePvtIndustry As PivotTable:   Set PiePvtIndustry = PieChtWS.PivotTables("PieChartIndustry")

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = False
    .EnableEvents = False
End With


On Error Resume Next
    PvtWB.SlicerCaches("Slicer_Investment_into").ClearManualFilter
    PvtWB.SlicerCaches("Slicer_Name").ClearManualFilter
    PvtWB.SlicerCaches("Period").ClearManualFilter
On Error GoTo 0

    LRow = DataWS.Cells(Rows.Count, 1).End(xlUp).Row


On Error Resume Next
    With PivotWS                    'Delete slicers before updating pivots
        .Shapes.Range(Array("Name")).Delete
        .Shapes.Range(Array("Underlying")).Delete
        .Shapes.Range(Array("Period")).Delete
    End With
On Error GoTo 0
                                                                 'Set source data
UnderlyingPvt.ChangePivotCache PvtWB.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DataWS.Range("A7:U" & LRow), Version:=6)
TotalPvt.CacheIndex = UnderlyingPvt.PivotCache.Index           'Link other pivots to same pivot cache
PiePvtCountry.CacheIndex = UnderlyingPvt.PivotCache.Index    'So that can add slicers to all the pivots
PiePvtIndustry.CacheIndex = UnderlyingPvt.PivotCache.Index


    UnderlyingPvt.PivotCache.Refresh
    TotalPvt.PivotCache.Refresh
    PiePvtCountry.PivotCache.Refresh
    PiePvtIndustry.PivotCache.Refresh

                                'Add slicers
    With PvtWB.SlicerCaches     'Criteria Field in the pvt table, Slicer name, slicer header
        .Add2(UnderlyingPvt, "Name").Slicers.Add PivotWS, , "Name", "Name", Range("A5").Top, Range("A5").Left, 180, 112.95
        .Add2(UnderlyingPvt, "Period").Slicers.Add PivotWS, , "Period", "Period", Range("A12").Top, Range("A12").Left, 180, 112.95
        .Add2(UnderlyingPvt, "Investment into Fund of Private Equity").Slicers.Add PivotWS, , "Underlying", "Investment into Fund of Private Equity", Range("A20").Top, Range("A20").Left, 180, 287.75
    End With
                                                'Link slicers to the other pivot tables
    With PvtWB                                  '"Slicer_slicer_header"... not slicer title
        .SlicerCaches("Slicer_Name").PivotTables.AddPivotTable (ActiveSheet.PivotTables("PvtChartTotal"))
        .SlicerCaches("Slicer_Name").PivotTables.AddPivotTable (PvtWB.Sheets("Piechart Data").PivotTables("PieChartCountry"))
        .SlicerCaches("Slicer_Name").PivotTables.AddPivotTable (PvtWB.Sheets("Piechart Data").PivotTables("PieChartIndustry"))

        .SlicerCaches("Slicer_Investment_into").PivotTables.AddPivotTable (ActiveSheet.PivotTables("PvtChartTotal"))
        .SlicerCaches("Slicer_Investment_into").PivotTables.AddPivotTable (PvtWB.Sheets("Piechart Data").PivotTables("PieChartCountry"))
        .SlicerCaches("Slicer_Investment_into").PivotTables.AddPivotTable (PvtWB.Sheets("Piechart Data").PivotTables("PieChartIndustry"))

        .SlicerCaches("Slicer_Period").PivotTables.AddPivotTable (ActiveSheet.PivotTables("PvtChartTotal"))
        .SlicerCaches("Slicer_Period").PivotTables.AddPivotTable (PvtWB.Sheets("Piechart Data").PivotTables("PieChartCountry"))
        .SlicerCaches("Slicer_Period").PivotTables.AddPivotTable (PvtWB.Sheets("Piechart Data").PivotTables("PieChartIndustry"))
    End With


With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = True
    .EnableEvents = True
End With


End Sub
...