折叠前几年的数据透视表详细信息答案

【问题标题】：Collapse pivot table detail for prior years折叠前几年的数据透视表详细信息
【发布时间】：2020-01-29 10:36:54
【问题描述】：

我有一个包含大约 120 个选项卡的工作簿，每个选项卡都包含一个或两个数据透视表。

数据透视表每月更新和刷新。

我正在努力折叠所有上一年的数据。

此代码有效，但我需要为之前的每一年更新并重新运行它：

Dim ws As Worksheet
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems("2015"). _
            ShowDetail = False
        On Error Resume Next
        ws.PivotTables("PivotTable2").PivotFields("Years").PivotItems("2015"). _
            ShowDetail = False
    End If
Next ws
End Sub

我更喜欢可以折叠所有前一年数据的代码。

我尝试了以下方法，它产生了一个

运行时错误 438 对象不支持此属性或方法：

Dim ws As Worksheet
Dim datecell As Range
Dim cy As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        'the following line produces the 
        ' run-time 438 object doesn't support this property or method error
        If Year(ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems) < cy Then
            PivotItem.ShowDetails = False
        End If
    End If
Next ws
End Sub

我也尝试了以下方法，它产生了一个

运行时错误 13 类型不匹配：

Dim ws As Worksheet
Dim datecell As Range
Dim cy As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        For Each PivotItem In ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems
            'the following line produces the run-time 13 type mismatch error
            If Year(PivotItem) < cy Then
                PivotItem.ShowDetails = False
            End If
        Next PivotItem
    End If
Next ws
End Sub

如何更正我的代码？

编辑 1：
下面的代码产生一个

运行时错误 438：对象不支持此属性或方法：

Dim ws As Worksheet
Dim pt As PivotTable
Dim ptItm As PivotItem
Dim datecell As Range
Dim cy As Long
Dim ptItmY As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        For Each pt In ws.PivotTables
            For Each ptItm In pt.PivotFields("Years").PivotItems
                ptItmY = Right(ptItm, 4)
                If ptItmY < cy Then
                    'the following line produces
                    ' run-time error 438: Object doesn't support this property or method
                    ptItm.ShowDetails = False
                    Else: ptItm.ShowDetails = True
                End If
            Next ptItm
        Next pt
    End If
Next ws
End Sub

数据透视表的上传图片：

【问题讨论】：

试试“If Year(PivotItem.Value)”。
@Qqqqq 试试我下面回答中的代码
@Mats Lind .value 不起作用，因为 Excel 添加了小于和大于值，因此并非年份字段中的所有值都采用 2015、2016 等格式。

标签： excel vba

【解决方案1】：

谢谢你帮我解决这个问题，Shai Rado。事实证明，如果我使用 ShowDetail 而不是 ShowDetails，我询问的最后一个代码会起作用。我想这一切都在细节中。 :)

如果其他人可能想要一个宏来折叠跨多个工作表的多个数据透视表中的所有前一年详细信息，这是我的最终代码：

Sub CollapsePYDetail()
'
' Colapse prior year detail
'
Dim ws As Worksheet
Dim pt As PivotTable
Dim ptItm As PivotItem
Dim datecell As Range
Dim cy As Long
Dim ptItmY As Long

'Turn off screen updating
Application.ScreenUpdating = False

'Change calculation option to manual
Application.Calculation = xlManual

'Make the status bar visible
Application.DisplayStatusBar = True

'Set the location where the cutoff date is stored (update the worksheet name and cell for your use)
Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets

    'Show the progress in the statusbar:
    Application.StatusBar = "Collapsing prior year detail on tab " & ws.Name

    'Loop through worksheets with pivot tables (update with your worksheet name criteria, or eliminate this if statement if you want to loop through all worksheets) 
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        'Loop through each pivot table on the worksheet
        For Each pt In ws.PivotTables
            'Loop through each item in the Years field, collapsing everything not in the current year
            For Each ptItm In pt.PivotFields("Years").PivotItems
                ptItmY = Right(ptItm, 4)
                If ptItmY = cy Then
                    ptItm.ShowDetail = True
                    'Use "on error to resume next" to prevent an error where the detail is already collapsed
                    On Error Resume Next
                    Else: ptItm.ShowDetail = False
                End If
            Next ptItm
        Next pt
    End If
Next ws

'Notify user the process has finished
MsgBox "Prior year detail has been collapsed for all tabs."

'Reset the statusbar:
Application.StatusBar = False

'Return calculation option to automatic
Application.Calculation = xlAutomatic

'Turn on screen updating
Application.ScreenUpdating = True

End Sub

【讨论】：

既然你拿走了我99%的代码，请将我的答案标记为“答案”
@Shai Rado 您确实帮助我微调了我的代码，我非常感谢您的意见。我最终使用了 8 月 17 日在这里发布的最终代码，直到今天才看到您 8 月 18 日的编辑。我很乐意将您的答案标记为“答案”，但我从未尝试过您最后帖子中的代码。我确实将您的答案标记为有用，但它没有显示，因为我没有状态。

【解决方案2】：

只要Range(H1).value 是日期（cy 是数字），那么下面的代码就会折叠所有年份

Option Explicit

Sub Collapse_Pivot_PrevYears()

Dim ws                  As Worksheet
Dim datecell            As Range
Dim cy                  As Long
Dim pvtFld              As PivotField
Dim pvtitem             As PivotItem
Dim pvtTbl              As PivotTable


Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then

        Set pvtTbl = ws.PivotTables("PivotTable1")

        ' set Pivot field variable to "Years"
        Set pvtFld = ws.PivotTables("PivotTable1").PivotFields("Years")

        For Each pvtitem In pvtFld.PivotItems
            Dim pvtYear         As Long

            ' added: manipulation of Date formats in different types of strings
            Select Case Len(pvtitem.Name)
                Case 4   ' date in format of "2011" , "2012"
                    pvtYear = CLng(pvtitem.Value)

                Case 11  ' date in format of "<01/01/2010"
                    pvtYear = year(CDate(Mid(pvtitem.Value, 2)))

                Case Else ' if you will have any other date formats in the future

            End Select

            If pvtYear < cy Then
                pvtFld.PivotItems(CStr(pvtYear)).ShowDetail = False
            Else
                pvtitem.ShowDetail = True
            End If



        Next pvtitem

    End If
Next ws

End Sub

【讨论】：

假设 2 不成立，因为 excel 将 8/1/2016 值添加到 Years 字段。我尝试更新我的代码，但现在我遇到了一个新错误。我编辑了我的问题以反映当前代码。任何进一步的建议将不胜感激！
@Qqqqq 现在买你改了邮编，有一半的回复是不相关的，一般我们不做SO。您以什么格式获得“年”字段？
@Qqqqq 尝试编辑代码（如果你的“Years”格式为“dd/dd/yyyy”）
抱歉更改原帖。我在这里是全新的，对显示更新代码的最佳方式有点困惑。我已经把原来的帖子放回去了，现在新代码显示为Edit 1。
你能上传一张你的数据透视表的屏幕截图吗？我想看看字段和数据的样子（我无法用我的数据模拟你的错误）

【解决方案3】：

OP 已经清楚地解决了问题，但我将发布我的代码是如何做到这一点的，以帮助将来访问此页面的读者。

这就是我创建 PivotField 的方式：

With PSheet.PivotTables("PivotTable").PivotFields("Date")
 .Orientation = xlRowField
 .Position = 1
 .DataRange.Cells(1).Group Periods:=Array(False, False, False, True, True, False, True)
 'Seconds-->Minutes-->Hours-->Days-->Months-->Quarters-->Years
End With

这是我将其展开/折叠到所需级别的方式：

With PSheet.PivotTables("PivotTable")
 .PivotFields("Years").ShowDetail = False
 .PivotFields("Months").ShowDetail = False
 .PivotFields("Years").PivotItems(Format(Now(), "yyyy")).DrillTo "Months"
End With

【讨论】：