繁体   English   中英

VBA Pivot 表过滤器运行时错误“1004”:应用程序定义或对象定义错误

[英]VBA Pivot Table Filter Run-time error '1004': Application-defined or object-defined error

我正在尝试编写 VBA 脚本以根据两个单元格中的值更新 pivot 表的过滤器,但我不断收到 1004 运行时错误。 我根据其他问题的答案尝试了各种方法,但我仍然无法弄清楚问题是什么。

注意:我读过有时会发生错误,因为 pivot 表需要至少一个可见值,但即使我设置 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

Output(第一项):

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

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

尝试添加条件以检查 pivot 项目是否可见

 ..... 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

感谢@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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM