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

只要Range(H1).value是一个日期（cy是一个数字），那么下面的代码就会折磨所有年份＆lt; 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

Answer 2

感谢您帮我解决这个问题，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 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

vba折叠前几年的数据透视表细节

3 个答案: