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：应用程序定义的错误或对象定义的错误”。

刷新表可以正常工作，但不能过滤表。

另一个复杂之处：如果表中不存在某个日期（例如Date From :），此方法是否可以工作？例如，如果我想在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

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

1 个答案: