数据透视表的VBA代码选择all，然后取消选择0和空白

Question

需要帮助编写VBA代码以在数据透视表中选择所有内容，并在同一工作表中为多个数据透视表取消选择0和空白。有时枢轴项可能在某些数据透视表中没有空白。我使用了录音功能，但它似乎没有录制取消选择0和空白。

Sheets("DATApivot").Select
ActiveSheet.PivotTables("PivotTable7").PivotFields("AmtIncurred").CurrentPage _
    = "(All)"
With ActiveSheet.PivotTables("PivotTable7").PivotFields("AmtIncurred")
    .PivotItems("0").Visible = True
    .PivotItems("(blank)").Visible = True

End With

Answer 1

可能有更好的方法，但这里有一个。注意我正在检查在尝试取消检查零和空白之前总会有一个项目可见。

Option Explicit

Public Sub FilterOutZeroAndBlanks()

    Dim pvt As PivotTable

    Set pvt = ThisWorkbook.Worksheets("DATApivot").PivotTables("PivotTable7")
    Dim pvtField As PivotField
    Set pvtField = pvt.PivotFields("AmtIncurred")

    Dim item As PivotItem
    Dim counter As Long
    Dim targetCounter As Long

    With pvtField

       For Each item In .PivotItems

           If item.Visible Then counter = counter + 1

       Next item

       If .PivotItems("0").Visible And .PivotItems("(blank)").Visible Then
            targetCounter = 2
       ElseIf .PivotItems("0").Visible Or .PivotItems("(blank)").Visible Then
            targetCounter = 1
       End If

       If Not targetCounter = counter Then

           .PivotItems("0").Visible = False
           .PivotItems("(blank)").Visible = False

       End If

    End With

End Sub

Answer 2

只需在代码的过滤部分之前放置On Error Resume Next，然后在On Error Goto 0之后放置，以便通过尝试过滤不存在​​的项而生成的任何错误都会被忽略：

Sub Macro1()

Dim pt As PivotTable
Dim pf As PivotField

Set pt = ActiveSheet.PivotTables("PivotTable1")
Set pf = pt.PivotFields("Value")
With pf
    .ClearAllFilters
    On Error Resume Next
        .PivotItems("(blank)").Visible = False
        .PivotItems("0").Visible = False
    On Error GoTo 0
End With
End Sub