Filter Last items of Pivot table (vba)

2019-08-19 18:14发布

问题:

SNapshot I have a pivot table that needs to show only the last 13 items (week). Below is teh code i used. However, what ever the Visible status of the item in the pivot, it does not change even forcing it to True/False. Already tried an if/else statement but still Visible state does not change.

Appreciate help on this. Thanks!

Sub ShowLastXDays()
Dim pi As PivotItem
Dim lLoop As Long
Dim pt As PivotTable
Dim pf As PivotField
Dim lCount As Long
Dim lDays As Long
Dim Count As Long

On Error Resume Next
lDays = 13


' Application.ScreenUpdating = False
Set pt = ActiveSheet.PivotTables("WeeklyPivot")
' Count = pt.PivotFields("[FTYieldData].[Week].[Week]").PivotItems.Count

  Set pf = ActiveSheet.PivotTables("WeeklyPivot").PivotFields("[FTYieldData].[Week].[Week]")

        For Each pi In pf.PivotItems
            pi.Visible = False  'issue encountered. after False code, pi.VISIBLE value remains TRUE (not skipped)
        Next pi

    With pt.PivotFields("[FTYieldData].[Week].[Week]")
        Count = .PivotItems.Count
        For lLoop = .PivotItems.Count To 1 Step -1
            .PivotItems(lLoop).Visible = True  'issue encountered. after TRUE code, since earlier it was not change to FALSE (no error encountered)
            lCount = lCount + 1
            If lCount = lDays Then Exit For
        Next lLoop
    End With

  On Error GoTo 0

回答1:

Problem:

  • .ClearFilters in your code makes all the Items Visible at once. So your loop that hides all the items is not in effect any more. After that you are looping to set some of those items to Visible, which is not applied as all the items are already visible.
  • On Error Resume Next. You cannot hide all the items in a Pivot Field, that should give you an Error, at least one item should be visible. So in your 1st Loop you will get an Error.

Try:

    Sub ShowLastXDays()
    Dim pf As PivotField
    Dim i As Integer

        ActiveSheet.PivotTables("WeeklyPivot").RefreshTable
        ActiveSheet.PivotTables("WeeklyPivot").PivotCache.MissingItemsLimit = xlMissingItemsNone


        Set pf = ActiveSheet.PivotTables("WeeklyPivot").PivotFields("[FTYieldData].[Week].[Week]")

        For i = 1 To pf.PivotItems.Count
            If i > pf.PivotItems.Count - 13 Then
                  pf.PivotItems(i).Visible = True
            Else: pf.PivotItems(i).Visible = False
            End If
        Next i

    End Sub

Working:

Note: Using On Error Resume Next is not a good approach as it only skips the error, which is sometimes very confusing while Debugging. Instead you should try to Handle the Errors.