使用 VBA 过滤枢轴 table

Question

我不太明白如何使用 vba 过滤我创建的数据透视表 table。我尝试使用的过滤器语法是最后一行。我目前正在从原始数据选项卡创建数据透视表 table，然后尝试过滤掉（空白）项目。

我试过 (空白), 0, "" 作为标准

Sub Test()
'Pivot Table
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim copyRng As Range
Dim destRng As Range

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"

Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("START")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).row
LastCol = DSheet.Cells(7, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(7, 1).Resize(LastRow, LastCol)

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
TableName:="PivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("EmpID")
.Orientation = xlRowField
.Position = 1
End With

'Insert Data Field

With ActiveSheet.PivotTables("PivotTable").PivotFields("DistinctCount")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "DistinctReferenceCount"
End With


'Format Pivot
TableActiveSheet.PivotTables("PivotTable").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("PivotTable").TableStyle2 = "PivotStyleMedium9"

ActiveSheet.PivotTables("PivotTable").RowAxisLayout xlOutlineRow
ActiveSheet.PivotTables("PivotTable").RepeatAllLabels xlRepeatLabels
Worksheets("PivotTable").Range("A1").AutoFilter Field:=3, Criteria1:="<>(blank)"

End Sub

Answer 1

对您的代码进行了一些改进，研究它们

Option Explicit

Sub Test()
On Error GoTo Err_Control
'Pivot Table
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim copyRng As Range
Dim destRng As Range

'Application.DisplayAlerts = False
'Worksheets("PivotTable").Delete
'Sheets.Add Before:=ActiveSheet
'ActiveSheet.Name = "PivotTable"

'----To Recreat your sheet....
Dim wrk As ThisWorkbook
Dim sht As Worksheet
Set wrk = ThisWorkbook
Dim trg As Worksheet
Dim Existe As Byte
    For Each sht In wrk.Worksheets
        If sht.Name = "PivotTable" Then
        Application.DisplayAlerts = False
            ThisWorkbook.Sheets("PivotTable").Delete
        Application.DisplayAlerts = True
        End If
    Next sht
    Application.ScreenUpdating = False
Existe = 0
    For Each sht In wrk.Worksheets
        If sht.Name = "PivotTable" Then
            Existe = 1
        End If
    Next sht
    If Existe = 0 Then
        Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
        trg.Name = "PivotTable"
    End If
'-----------------------------------------

Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("START")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(7, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(7, 1).Resize(LastRow, LastCol)

'Define Pivot Cache
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange, Version:=6). _
CreatePivotTable TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable", DefaultVersion:=6

'Insert Blank Pivot Table ' Don't need that, lines over create pivot table
'Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("EmpID")
.Orientation = xlRowField
.Position = 1
End With

'Insert Data Field
With ActiveSheet.PivotTables("PivotTable").PivotFields("DistinctCount")
.Orientation = xlDataField
'.Position = 2 'Don't need that, generates error
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "DistinctReferenceCount"
End With

'Format Pivot Table
ActiveSheet.PivotTables("PivotTable").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("PivotTable").TableStyle2 = "PivotStyleMedium9"
   
ActiveSheet.PivotTables("PivotTable").RowAxisLayout xlOutlineRow
ActiveSheet.PivotTables("PivotTable").RepeatAllLabels xlRepeatLabels
ActiveSheet.PivotTables("PivotTable").PivotFields("DistinctCount").PivotItems("(blank)").Visible = False

Err_Control:
If Err.Number <> 0 Then
    MsgBox Err.Description
    'here you handle the errors, if an error appears,
    'press Ctrl + Pause Break that you can go to the error location using
    'resume next
    'below this msgbox err.description
End If
End Sub

使用 VBA 过滤枢轴 table

Filter Pivot table with VBA

excel

vba

pivot-table