Question

我正在尝试从同一数据源制作多个数据透视表。我希望数据透视表位于单独的工作表上。截至目前，我有一个宏可以创建一个数据透视表并按照自己的意愿对其进行格式化，但是我在弄清楚如何制作多个数据透视表时遇到了麻烦。数据透视表之间的唯一区别是选择了哪些筛选器。

这是我必须制作一个数据透视表的代码。我知道我必须删除Worksheets.Delete行，但是当我尝试这样做并添加更多工作表时，我遇到了错误，因此，我只提供适用于其中一个的代码。如果有人对要进行多次更改有什么建议，那就太好了。谢谢！

Sub PivotTable()

'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

'Insert a New Blank Worksheet
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("Data")

'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(2, 2), _
TableName:="ExpensePivot")

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

'Insert Filter Fields
With ActiveSheet.PivotTables("ExpensePivot").PivotFields("month_number")
.Orientation = xlPageField
.Position = 1
End With

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

With ActiveSheet.PivotTables("ExpensePivot").PivotFields("summary_point_18")
.Orientation = xlRowField
.Position = 2
End With

With ActiveSheet.PivotTables("ExpensePivot").PivotFields("cost_element_description")
.Orientation = xlRowField
.Position = 3
End With

With ActiveSheet.PivotTables("ExpensePivot").PivotFields("cost_element")
.Orientation = xlRowField
.Position = 4
End With

With ActiveSheet.PivotTables("ExpensePivot").PivotFields("description")
.Orientation = xlRowField
.Position = 5
End With

With ActiveSheet.PivotTables("ExpensePivot").PivotFields("vendor_name")
.Orientation = xlRowField
.Position = 6
End With

With ActiveSheet.PivotTables("ExpensePivot").PivotFields("employee_name")
.Orientation = xlRowField
.Position = 7
End With

'Insert Column Fields

'Insert Data Field
With ActiveSheet.PivotTables("ExpensePivot").PivotFields("Amount")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "Amount" 'Changed Revenue to Amount
End With

'Remove Subtotals
    ActiveSheet.PivotTables("ExpensePivot").PivotFields("cost_element"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("ExpensePivot").PivotFields("description"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("ExpensePivot").PivotFields("vendor_name"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)

'Highlight subtotals
    ActiveSheet.PivotTables("ExpensePivot").PivotSelect _
        "cost_element_description[All;Total]", xlDataAndLabel, True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
ActiveSheet.PivotTables("ExpensePivot").PivotSelect _
        "summary_point_18[All;Total]", xlDataAndLabel, True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
ActiveSheet.PivotTables("ExpensePivot").PivotSelect "charge_cc[All;Total]", _
        xlDataAndLabel, True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

'Format Total Column with Commas
    Columns("I:I").Select
    Selection.Style = "Comma"


End Sub

来自同一数据源的多个数据透视表

0 个答案: