以前年度的折叠数据透视表详细信息

Question

我有一本工作簿，带有大约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

枢纽分析表的上载图片：

Answer 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

Answer 2

只要Range(H1).value是日期（cy是数字），则下面的代码会折叠所有Years

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

Answer 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