使用单元格值过滤日期之间的数据透视表

Question

我有一个数据透视表，其中列出了在某个日期范围内售出的库存商品数量。开始日期和开始日期存储在单元格中，以便用户可以修改它们。

我编写了引用这些单元格的代码并尝试过滤工作表上的数据透视表。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = ActiveSheet.Range("E3").Address Then
        ActiveSheet.PivotTables("ItemsSold").RefreshTable
    ElseIf Target.Address = ActiveSheet.Range("I3").Address Then
        ActiveSheet.PivotTables("ItemsSold").RefreshTable
    End If

    ActiveSheet.PivotTables("ItemsSold").PivotFields("Date Sold ").PivotFilters.Add _
        Type:=xlDateBetween, _
        Value1:=CLng(Range("E3").value), _
        Value2:=CLng(Range("I3").value)

End Sub

我明白了

“运行时错误 1004：应用程序定义的或对象定义的错误”。

刷新表正常工作，但过滤它不是。

另一个复杂情况：如果表格中不存在其中一个日期（例如，日期从：），这会起作用吗？例如，如果我想在 1 月 1 日和今天之间进行过滤，但数据表中没有 1 月的日期，那么这段代码是否仍然可以正常执行？

Answer 1

Date Sold 字段可以位于行或列标签区域，或报表过滤器区域，如屏幕截图所示：

行标签区域

报表过滤区

以下代码应粘贴在工作表模块中，它由两个子部分组成，第一个用于处理位于报表过滤区域的字段，第二个用于行或列标签区域：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rFrom As Range
    Dim rUpto As Range
    Dim lFrom As Long
    Dim lUpto As Long
    Dim oPivotField As PivotField
    Dim oPivotItem As PivotItem
    Dim sFmt As String
    Dim bItemVisible As Boolean
    Dim cPivotFilters As PivotFilters
    Dim oFilter As PivotFilter

    Set rFrom = ActiveSheet.Range("E3")
    Set rUpto = ActiveSheet.Range("I3")
    If Target.Address = rFrom.Address Or Target.Address = rUpto.Address Then
        Set oPivotField = ActiveSheet.PivotTables("ItemsSold").PivotFields("Date Sold")
        Select Case oPivotField.Orientation
            ' Check if field located in Report Filter area
            Case xlPageField
                ' Prepare for update
                Application.EnableEvents = False
                Application.ScreenUpdating = False
                On Error Resume Next ' to be sure the initial state is restored
                ' Remove existing filters for pivot field
                oPivotField.EnableMultiplePageItems = True
                oPivotField.ClearAllFilters
                ' Store current field format
                sFmt = oPivotField.NumberFormat
                ' Change format to compare Long type values and avoid date formats regional mess
                oPivotField.NumberFormat = "0"
                If IsDate(rFrom) Then
                    lFrom = CLng(rFrom)
                Else
                    lFrom = 0
                End If
                If IsDate(rUpto) Then
                    lUpto = CLng(rUpto)
                Else
                    lUpto = 2958465
                End If
                ' Loop through each page field item and check if at least one item is visible
                For Each oPivotItem In oPivotField.PivotItems
                    bItemVisible = oPivotItem.Value >= lFrom And oPivotItem.Value <= lUpto
                    If bItemVisible Then Exit For
                Next
                If bItemVisible Then
                    ' Loop through each page field item and switch visibility
                    For Each oPivotItem In oPivotField.PivotItems
                        oPivotItem.Visible = oPivotItem.Value >= lFrom And oPivotItem.Value <= lUpto
                    Next
                Else
                    MsgBox "There is no data to show for range you set", vbInformation
                End If
                ' Restore initial state
                oPivotField.NumberFormat = sFmt
                Application.EnableEvents = True
                Application.ScreenUpdating = True
                On Error GoTo 0
                ActiveSheet.PivotTables("ItemsSold").RefreshTable
            ' Check if field located in Row or Column Labels area
            Case xlColumnField, xlRowField
                Set cPivotFilters = oPivotField.PivotFilters
                ' Prepare for update
                Application.EnableEvents = False
                Application.ScreenUpdating = False
                On Error Resume Next ' to be sure the initial state is restored
                ' Remove existing date filters for pivot field
                Set cPivotFilters = ActiveSheet.PivotTables("ItemsSold").PivotFields("Date Sold").PivotFilters
                For Each oFilter In cPivotFilters
                    If _
                        oFilter.FilterType = xlDateBetween Or _
                        oFilter.FilterType = xlBefore Or _
                        oFilter.FilterType = xlAfter Then _
                            oFilter.Delete
                Next
                ' Add new filter regarding of set range
                Select Case True
                    Case IsDate(rFrom) And IsDate(rUpto)
                        cPivotFilters.Add Type:=xlDateBetween, Value1:=CDbl(rFrom), Value2:=CDbl(rUpto)
                    Case IsDate(rFrom)
                        cPivotFilters.Add Type:=xlAfter, Value1:=CDbl(rFrom)
                    Case IsDate(rUpto)
                        cPivotFilters.Add Type:=xlBefore, Value1:=CDbl(rUpto)
                End Select
                ' Restore initial state
                Application.EnableEvents = True
                Application.ScreenUpdating = True
                On Error GoTo 0
                ActiveSheet.PivotTables("ItemsSold").RefreshTable

            Case Else
                MsgBox "The field should be located in Row or Column Labels area, or Report Filter area", vbInformation
            End Select
    End If

End Sub