按日期间隔使用VBA过滤数据透视表

Question

我正在编写一个宏来根据a更改数据透视表中的数据 年 - 月过滤器。只要数据透视表中的数据落在2个月之内 在以下字符串格式中，应显示它。

2016 - 01
2016 - 05

日期间隔也采用此格式。 这根本没有更新数据透视表。我感谢任何反馈或替代更新数据透视表，给定两个日期间隔作为其过滤器。

Private Sub Worksheet_Change（ByVal Target As Range）

    Dim shPT As Worksheet
    Dim pt As PivotTable
    Dim pi As PivotItem

    Dim d As Date
    Dim dStart As Date
    Dim dEnd As Date

    '' G4 and G7 are the cell locations of the start and ending year-months.
    dStart = DateSerial(Left(Range("G4"), 4), Right(Range("G4"), 2), 15)
    dEnd = DateSerial(Left(Range("G7"), 4), Right(Range("G7"), 2), 15)


    '' Calendar Filter in the Pivot Tables
    Dim strCal

    strCal = "Date Entered UTC"

    On Error Resume Next
    Application.EnableEvents = False
    Application.ScreenUpdating = False


            Set shPT = ActiveWorkbook.Worksheets("PivotTables")

                For Each pt In shPT.PivotTables


                    With pt.PageFields(strCal)

                        For Each pi In .PivotItems

                            '' Loop through all year-month for each pi.
                            For d = dStart To dEnd Step 30
                                If pi.Value = Year(d) & " - " & Month(d) Then
                                    .CurrentPage = Year(d) & " - " & Month(d)
                                    Exit For
                                Else
                                    .CurrentPage = "(All)"
                                End If
                            Next d
                        Next pi
                    End With
            Next pt


    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Answer 1

我发现了另一种有效的方法。 取代

For Each pt In shPT.PivotTables
           With pt.PageFields(strCal)

                    For Each pi In .PivotItems

                        '' Loop through all year-month for each pi.
                        For d = dStart To dEnd Step 30
                            If pi.Value = Year(d) & " - " & Month(d) Then
                                .CurrentPage = Year(d) & " - " & Month(d)
                                Exit For
                            Else
                                .CurrentPage = "(All)"
                            End If
                        Next d
                    Next pi
                End With
        Next pt

使用

Dim i As Integer
                Dim checkDate As Date

                For Each pt In shPT.PivotTables

                    Set pf = pt.PivotFields(strCal)
                    pf.ClearAllFilters
                    pf.EnableMultiplePageItems = True

                    '' Loop through the dates in the Pivot Table.
                    For i = 1 To pf.PivotItems.Count

                        checkDate = DateSerial(Left(pf.PivotItems(i), 4), Right(pf.PivotItems(i), 2), 15)

                        '' If each date is outside the boundaries of the date intervals, then
                        '' turn them off.
                        If checkDate < dStart Or checkDate > dEnd Then
                            pf.PivotItems(i).Visible = False
                        End If
                    Next i

Chris Newman的blog提供了有关在数据透视表中过滤多个选项的好建议。