Question

请求帮助我目前正在处理一个基于宏的数据透视表，我们在报表过滤器中有5列。我正在寻找的是这五个文件管理器的vba代码，如果过滤器包含单个值，它应显示值，否则应保留为（全部）。

目前我正在使用以下代码进行透视文件管理器：

    Sub InsertPivotTable()

'Declare Variables
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

'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Pivot").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Pivot"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Pivot")
Set DSheet = Worksheets("Report")


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

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

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

'Insert Reportfilter Fields
   With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("Resp Bus Partn ID")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("ADT-File ID")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("UWY")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("SCoB - Acc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("ADT_PivotTable").PivotFields("Curr")
        .Orientation = xlPageField
        .Position = 1
    End With
End Sub

Answer 1

答案和代码有点长，但我已经添加了一些＆＃34;奖金＆＃34;为了你，所以你会发现它非常有用：）

首先，无需删除＆＃34; Pivot＆＃34;表单并重新创建它只是为了更新名为＆{34; ADT_PivotTable＆＃34;的PivotTable，您只需使用更新的PivotCache更新SourceData，然后刷新{{ 1}}使用更新的PivotTable。

第二次，我添加了第二个PivotCache，检查传递给它的每个Sub它有多少PivotField，如果只有一个PivotItems PivotItem然后将其显示在过滤器中，否则显示＆＃34;全部＆＃34;。

Sub InsertPivotTable 代码

Option Explicit

Sub InsertPivotTable()

'Declare Variables
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

'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False

Set PSheet = Worksheets("Pivot")
On Error GoTo 0
If PSheet Is Nothing Then ' if "Pivot" sheet doesn't exist
    Set PSheet = Sheets.Add(Before:=ActiveSheet)
    PSheet.Name = "Pivot"
End If
Application.DisplayAlerts = True

Set DSheet = Worksheets("Report")
'Define Data Range
With DSheet
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set PRange = .Range("A1").Resize(LastRow, LastCol) ' set data range for Pivot Table
End With

' Set the Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)

On Error Resume Next
Set PTable = PSheet.PivotTables("ADT_PivotTable") ' Set the Pivot Table if already exists from previous code runs

On Error GoTo 0
If PTable Is Nothing Then ' <-- Pivot Table still doesn't exist >> create it for the first time
    ' create a new Pivot Table in "Pivot" sheet
    Set PTable = PSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=PSheet.Range("A1"), TableName:="ADT_PivotTable")

    With PTable
        'Insert Reportfilter Fields
        With .PivotFields("Resp Bus Partn ID")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("ADT-File ID")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("UWY")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("SCoB - Acc")
            .Orientation = xlPageField
            .Position = 1
        End With
        With .PivotFields("Curr")
            .Orientation = xlPageField
            .Position = 1
        End With
    End With
Else
    ' just refresh the Pivot cache with the updated Range
    PTable.ChangePivotCache PCache
    PTable.RefreshTable
End If

' modify the Filter default view for each of the Pivot Fields below
With PTable
    SelectFilterSingleValue .PivotFields("Resp Bus Partn ID")
    SelectFilterSingleValue .PivotFields("ADT-File ID")
    SelectFilterSingleValue .PivotFields("UWY")
    SelectFilterSingleValue .PivotFields("SCoB - Acc")
    SelectFilterSingleValue .PivotFields("Curr")
End With

End Sub

Sub SelectFilterSingleValue 代码

Sub SelectFilterSingleValue(ptFld As PivotField)

Dim PTItm       As PivotItem
Dim Count       As Long

With ptFld
    .EnableMultiplePageItems = True

    For Each PTItm In .PivotItems
        If PTItm.Name <> "(blank)" Then
            PTItm.Visible = True
            Count = Count + 1
        Else
            PTItm.Visible = False
        End If
    Next PTItm

    If Count > 1 Then
        .ClearAllFilters
    End If
End With

End Sub

透视报告过滤器 - 如果只有一个值可用，则选择其他ALL

1 个答案: