Filtering pivot table with vba

£可爱£侵袭症+ 提交于 2019-11-27 16:30:46

It's not possible to hide all items in a PivotField. You always have to leave at least one visible.

It will be much faster and easier if you use VBA to leverage the inbuilt Date Filters functionality i.e. this:

Here's a sample file where I do just that: https://1drv.ms/x/s!Ah_zTnaUo4DzjhezQ3OTq9tq1APC

Note that this functionality is only available on RowFields or ColumnFields. So my code below won't work on PageFields.

Here's a generic routine that lets you choose what interval type and interval period you want to filter the pivot field on, as well as optionally select the date you want to count forward/back from.

Sub Pivots_FilterPeriod(sInterval As String, _
                        lNumber As Long, _
                        Optional vRelativeTo As Variant, _
                        Optional pf As PivotField)

    'Programmer:        Jeff Weir
    'Contact:           weir.jeff@gmail.com
    'Description:       Lets you programatically filter a Pivot RowField or ColumnField by specifying
    '                   an interval type (e.g. days, weeks, months, quarters, years)
    '                   as well as an interval count (e.g. 7, -7)
    '                   If the optional vRelativeTo field is left blank, it counts back/foward from
    '                   the youngest/oldest item depending on whether lNumber is positive/negative
    '                   It leverages off the inbuilt DateFilters functionality, and as such does not
    '                   work on RowFields.


    Dim dteDateAdd As Date
    Dim dteFrom As Date
    Dim dteTo As Date

    On Error GoTo errhandler

    If pf Is Nothing Then
        On Error Resume Next
        Set pf = ActiveCell.PivotField
        On Error GoTo errhandler
        If pf Is Nothing Then GoTo errhandler
    End If

    With pf
        If .DataType = xlDate _
            And .Orientation <> xlPageField _
            And .Orientation <> xlDataField Then

            If IsMissing(vRelativeTo) Or vRelativeTo = "" Then
                .AutoSort xlAscending, "Date"
                If lNumber > 0 Then
                    vRelativeTo = .PivotItems(1)
                Else
                    vRelativeTo = .PivotItems(.PivotItems.Count)
                End If
            End If

            Select Case UCase(sInterval)
                Case "D", "DD", "DDD", "DDDD", "DAY", "DAYS": sInterval = "d"
                Case "W", "WW", "WWW", "WWWW", "WEEK", "WEEKS": sInterval = "ww"
                Case "M", "MM", "MMM", "MMMM", "MONTH", "MONTHS": sInterval = "m"
                Case "Q", "QQ", "QQQ", "QQQQ", "QUARTER", "QUARTERS": sInterval = "q"
                Case "Y", "YY", "YYY", "YYYY", "YEAR", "YEARS": sInterval = "yyyy"
            End Select

            dteDateAdd = DateAdd(sInterval, lNumber, vRelativeTo)
            If lNumber > 0 Then
                dteDateAdd = dteDateAdd - 1
            Else
                dteDateAdd = dteDateAdd + 1
            End If

            If dteDateAdd < vRelativeTo Then
                dteFrom = dteDateAdd
                dteTo = vRelativeTo
            Else
                dteFrom = vRelativeTo
                dteTo = dteDateAdd
            End If

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

            .ClearAllFilters
            .PivotFilters.Add2 _
                Type:=xlDateBetween, _
                Value1:=CStr(dteFrom), _
                Value2:=CStr(dteTo)
        End If
    End With

errhandler:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Here's some screenshots demonstrating how it looks in practice, using different parameters.

This shows how to filter on the last 5 days from the most recent data:

And by changing the sign, it works out that we must want the first 5 days from the oldest data on record:

If you specify an actual date in that RelativeTo field, it will count forward/back from there depending on whether the Number parameter is positive/negative. Here's the next 5 days from today's date as I write this:

...and here's the last 5 days:

It will let you specify whether you want days, weeks, quarters, months, or years. For instance, here's the last 2 weeks counting back from the most recent record:

I'm using a Worksheet_Change event here to trigger it, but you can hook it up to a button if you like, and feed it the parameters you want.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bContinue As Boolean
    If Not Intersect(Target, Range("Interval")) Is Nothing Then bContinue = True
    If Not Intersect(Target, Range("Number")) Is Nothing Then bContinue = True
    If Not Intersect(Target, Range("RelativeTo")) Is Nothing Then bContinue = True
    If bContinue Then Pivots_FilterPeriod [Interval], [Number], [RelativeTo], Sheet1.PivotTables(1).PivotFields("Date")

End Sub
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!