VBA 数据透视表筛选器运行时错误"1004"：应用程序定义或对象定义的错误

Question

我正试图编写一个VBA脚本，根据两个单元格中的值更新数据透视表的筛选器，但我一直收到1004运行时错误。我根据其他问题的答案尝试了各种方法，但我仍然不知道问题出在哪里

注意：我读到错误有时会发生，因为数据透视表至少需要一个可见值，但即使我设置visible=True，也会发生此错误

VBA代码：

Private Sub PageItemFilter()
Dim pvtF As PivotField
Dim pvtI As PivotItem
Dim startDate As Date
Dim endDate As Date
Dim filterDate As Date
startDate = Range("start_date").Value
endDate = Range("end_date").Value
Set pvtF = Worksheets("selection").PivotTables("PivotTable1").PivotFields("[tbl_Main].[TransactionDate].[TransactionDate]")
pvtF.ClearAllFilters
For Each pvtI In pvtF.PivotItems
filterDate = DateValue(Mid(pvtI.Name, 24, 10))
If filterDate >= startDate And filterDate <= endDate Then
Debug.Print (pvtI.Name)
Debug.Print (TypeName(pvtI))
Debug.Print (pvtI.Visible)
pvtI.Visible = True
Else
pvtI.Visible = False
End If
Next pvtI
End Sub

输出(第一项(：

[tbl_Main].[TransactionDate].&[2019-08-05T00:00:00]
PivotItem
True

错误：Run-time error '1004': Application-defined or object-defined error

Answer 1

尝试添加条件以检查是否像一样显示透视项目

..... code
if not pvtI.Visible = True then pvtI.Visible = True 
Else
if not pvtI.Visible = false then pvtI.Visible = false 
End If
Next pvtI
End Sub

Answer 2

感谢@TimWilliams指导我找到这个解决方案。简单的回答是，我试图用OLAP数据透视表做的事情是不可能的。我实现了建议解决方案的一个版本，它就像一个魅力！我在下面列出了我的解决方案代码，供遇到这个问题的人使用。

Sub PageItemFilter()
Dim pvtF As PivotField
Dim pvtI As PivotItem
Dim startDate As Date
Dim endDate As Date
Dim filterDate As Date
Dim visibleArray() As String
Dim isEmpty As Boolean
ReDim visibleArray(1 To 1) As String
startDate = Range("start_date").Value
endDate = Range("end_date").Value
isEmpty = True
Worksheets("selection").Activate
Set pvtF = Worksheets("selection").PivotTables("PivotTable1").PivotFields("[tbl_Main].[TransactionDate].[TransactionDate]")
pvtF.ClearAllFilters
If startDate > endDate Then
MsgBox "The start date is after the end date. Cannot update filters"
Exit Sub
End If
For Each pvtI In pvtF.PivotItems
filterDate = DateValue(Mid(pvtI.Name, 35, 10))
If filterDate >= startDate And filterDate <= endDate Then
isEmpty = False
visibleArray(UBound(visibleArray)) = pvtI.Name
If filterDate >= endDate Then
Exit For
Else
ReDim Preserve visibleArray(1 To UBound(visibleArray) + 1) As String
End If
End If
Next pvtI
If isEmpty Then
MsgBox "No data for the dates selected. Cannot update filters"
Exit Sub
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields("[tbl_Main].[TransactionDate].[TransactionDate]").VisibleItemsList = visibleArray
End If
End Sub