EXCEL VBA 按日期范围过滤数据透视行标签答案

【问题标题】：EXCEL VBA to Filter Pivot Row Labels by Date RangeEXCEL VBA 按日期范围过滤数据透视行标签
【发布时间】：2015-06-30 01:15:00
【问题描述】：

早安，

我正在尝试通过单元格引用（“E6：E12”）根据其他单元格中的日期范围（基本上是选择过去 6 天的日期）来过滤数据透视表行标签（“日期”）

我用谷歌搜索了很多，找到了一些代码，效果很好；但是代码随机中断，不知道为什么

谁能提出一个更简单的 VBA 来根据日期范围过滤行标签

代码：

Public Function Filter_PivotField_by_Date_Range(pvtField As PivotField, _
    dtFrom As Date, dtTo As Date)
Dim bTemp As Boolean, i As Long
Dim dtTemp As Date, sItem1 As String

On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With pvtField
    .Parent.ManualUpdate = True
    For i = 1 To .PivotItems.Count
        dtTemp = .PivotItems(i)
        bTemp = (dtTemp >= dtFrom) And _
            (dtTemp <= dtTo)
        If bTemp Then
            sItem1 = .PivotItems(i)
            Exit For
        End If
    Next i
    If sItem1 = "" Then
        MsgBox "No items are within the specified dates."
        Exit Function
    End If
    If .Orientation = xlPageField Then .EnableMultiplePageItems = True
    .PivotItems(sItem1).Visible = True
    For i = 1 To .PivotItems.Count
        dtTemp = .PivotItems(i)
        If .PivotItems(i).Visible <> _
            ((dtTemp >= dtFrom) And (dtTemp <= dtTo)) Then
            .PivotItems(i).Visible = Not .PivotItems(i).Visible
        End If
    Next i
End With

pvtField.Parent.ManualUpdate = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Function

Sub TESTUPDATE()

'Set the Variables to be used
Dim PT As PivotTable
Dim PT1 As PivotTable
Dim Field As PivotField
Dim NewCat As String

'Here you amend to suit your data
Set PT = Workbooks("KPI     Dashboard").Worksheets("Sheet1").PivotTables("TESTPIVOT")
Set PT1 = Workbooks("KPI  Dashboard").Worksheets("Sheet1").PivotTables("PivotTable2")
Set Field = PT.PivotFields("Date")
Set Field1 = PT1.PivotFields("Date")
NewCat = Workbooks("KPI Dashboard").Worksheets("Sheet1").Range("E7").Value

'This updates and refreshes the PIVOT table
With PT
Field.ClearAllFilters
Field.CurrentPage = NewCat
PT.RefreshTable
End With

'This is the actual code that applies the filter    
Dim Rng As Range
Dim PItem As PivotItem
With ActiveSheet
    Set Rng = .Range("G10:G15")
    For Each PItem In  .PivotTables("PivotTable2").RowFields("Date").PivotItems
    PItem.Visible = WorksheetFunction.CountIf(Rng, PItem.Name) > 0
    Next PItem
End With   
End Sub

PItem.Visible = WorksheetFunction.CountIf(Rng, PItem.Name) > 0 "Run Time Error - 1004. Unable to set the visible property of the pivotitem class" 出现错误

还有一段代码替换了之前负责应用过滤器的最后一段代码；但是根本不起作用（即枢轴上没有变化）：

Dim dtFrom As Date, dtTo As Date

With Sheets("Sheet1")
    dtFrom = .Range("E12")
    dtTo = .Range("E7")
End With

With PT1
Call Filter_PivotField_by_Date_Range( _
    PT.PivotFields("Date"), dtFrom, dtTo)
End With

【问题讨论】：

标签： excel vba filter pivot

【解决方案1】：

没关系，第二个代码有效，我在代码中无知地调用了不正确的数据透视表：

Call Filter_PivotField_by_Date_Range( _
PT.PivotFields("Date"), dtFrom, dtTo)

我只是将 PT 更改为 PT1，瞧 :) 希望这对以后遇到类似问题的人有所帮助

【讨论】：