office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

Excel-VBA編程操作透視錶Pivot Table代碼大全

2021-02-12 08:00:00
www.thespreadsheetguru.com
轉貼
15001



Excel的Pivot Table在我們平時的辦公場景 學習 以及 工作中都常用到,但如果想自動化快速操作透視錶,那肯定離不開VBA,但如何通過VBA自動操作Pivot Table呢。下麵列齣國外一箇作者有關VBA操作透視錶Pivot Table代碼大全,非常齊全

vba創建透視錶:Create A Pivot Table

Sub CreatePivotTable()
'PURPOSE: Creates a brand new Pivot table on a new worksheet from data in the ActiveSheet
'Source: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String

'Determine the data range you want to pivot
SrcData = ActiveSheet.Name & "!" & Range("A1:R100").Address(ReferenceStyle:=xlR1C1)

'Create a new worksheet
Set sht = Sheets.Add

'Where do you want Pivot Table to start?
StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)

'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1")

End Sub


vba

刪除指定的透視錶:Delete A Specific Pivot Table

Sub DeletePivotTable()
'PURPOSE: How to delete a specifc Pivot Table
'SOURCE: www.TheSpreadsheetGuru.com

'Delete Pivot Table By Name
ActiveSheet.PivotTables("PivotTable1").TableRange2.Clear

End Sub



VBA刪除所有透視錶:Delete All Pivot Tables

Sub DeleteAllPivotTables()
'PURPOSE: Delete all Pivot Tables in your Workbook
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim pvt As PivotTable

'Loop Through Each Pivot Table In Currently Viewed Workbook
For Each sht In ActiveWorkbook.Worksheets
For Each pvt In sht.PivotTables
pvt.TableRange2.Clear
Next pvt
Next sht

End Sub


VBA添加透視錶字段:Add Pivot Fields


Sub Adding_PivotFields()
'PURPOSE: Show how to add various Pivot Fields to Pivot Table
'SOURCE: www.TheSpreadsheetGuru.com
'translate by tmtony (www.office-cn.net)


Dim pvt As PivotTable

Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Add item to the Report Filter
pvt.PivotFields("Year").Orientation = xlPageField

'Add item to the Column Labels
pvt.PivotFields("Month").Orientation = xlColumnField

'Add item to the Row Labels
pvt.PivotFields("Account").Orientation = xlRowField

'Position Item in list
pvt.PivotFields("Year").Position = 1

'Format Pivot Field
pvt.PivotFields("Year").NumberFormat = "#,##0"

'Turn on Automatic updates/calculations --like screenupdating to speed up code
pvt.ManualUpdate = False

End Sub



VBA添加透視錶計祘字段 :Add Calculated Pivot Fields

Sub AddCalculatedField()
'PURPOSE: Add a calculated field to a pivot table
'SOURCE: www.TheSpreadsheetGuru.com

Dim pvt As PivotTable
Dim pf As PivotField

'Set Variable to Desired Pivot Table
Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Set Variable Equal to Desired Calculated Pivot Field
For Each pf In pvt.PivotFields
If pf.SourceName = "Inflation" Then Exit For
Next

'Add Calculated Field to Pivot Table
pvt.AddDataField pf

End Sub


VBA添加值字段:Add A Values Field


Sub AddValuesField()
'PURPOSE: Add A Values Field to a Pivot Table
'SOURCE: www.TheSpreadsheetGuru.com
'translate by tmtony


Dim pvt As PivotTable
Dim pf As String
Dim pf_Name As String

pf = "Salaries"
pf_Name = "Sum of Salaries"

Set pvt = ActiveSheet.PivotTables("PivotTable1")

pvt.AddDataField pvt.PivotFields("Salaries"), pf_Name, xlSum

End Sub



VBA刪除透視錶字段:Remove Pivot Fields

Sub RemovePivotField()
'PURPOSE: Remove a field from a Pivot Table
'SOURCE: www.TheSpreadsheetGuru.com

'Removing Filter, Columns, Rows
ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").Orientation = xlHidden

'Removing Values
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Salaries").Orientation = xlHidden

End Sub


VBA刪除透視錶計祘字段: Remove Calculated Pivot Fields

Sub RemoveCalculatedField()
'PURPOSE: Remove a calculated field from a pivot table
'SOURCE: www.TheSpreadsheetGuru.com

Dim pvt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem

'Set Variable to Desired Pivot Table
Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Set Variable Equal to Desired Calculated Data Field
For Each pf In pvt.DataFields
If pf.SourceName = "Inflation" Then Exit For
Next

'Hide/Remove the Calculated Field
pf.DataRange.Cells(1, 1).PivotItem.Visible = False

End Sub


報錶按單箇項目篩選:Report Filter On A Single Item

Sub ReportFiltering_Single()
'PURPOSE: Filter on a single item with the Report Filter field
'SOURCE: www.TheSpreadsheetGuru.com

Dim pf As PivotField

Set pf = ActiveSheet.PivotTables("PivotTable2").PivotFields("Fiscal_Year")

'Clear Out Any Previous Filtering
pf.ClearAllFilters

'Filter on 2014 items
pf.CurrentPage = "2014"

End Sub


透視錶報錶按多項篩選:Report Filter On Multiple Items

Sub ReportFiltering_Multiple()
'PURPOSE: Filter on multiple items with the Report Filter field
'SOURCE: www.TheSpreadsheetGuru.com

Dim pf As PivotField

Set pf = ActiveSheet.PivotTables("PivotTable2").PivotFields("Variance_Level_1")

'Clear Out Any Previous Filtering
pf.ClearAllFilters

'Enable filtering on multiple items
pf.EnableMultiplePageItems = True

'Must turn off items you do not want showing
pf.PivotItems("Jan").Visible = False
pf.PivotItems("Feb").Visible = False
pf.PivotItems("Mar").Visible = False

End Sub


VBA清除透視錶報錶篩選:Clear Report Filter

Sub ClearReportFiltering()
'PURPOSE: How to clear the Report Filter field
'SOURCE: www.TheSpreadsheetGuru.com

Dim pf As PivotField

Set pf = ActiveSheet.PivotTables("PivotTable2").PivotFields("Fiscal_Year")

'Option 1: Clear Out Any Previous Filtering
pf.ClearAllFilters

'Option 2: Show All (remove filtering)
pf.CurrentPage = "(All)"

End Sub


VBA刷新透視錶:Refresh Pivot Table(s)

Sub RefreshingPivotTables()
'PURPOSE: Shows various ways to refresh Pivot Table Data
'SOURCE: www.TheSpreadsheetGuru.com

'Refresh A Single Pivot Table
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

'Refresh All Pivot Tables
ActiveWorkbook.RefreshAll

End Sub


VBA修改透視錶數據源區域:Change Pivot Table Data Source Range

Sub ChangePivotDataSourceRange()
'PURPOSE: Change the range a Pivot Table pulls from
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim SrcData As String
Dim pvtCache As PivotCache

'Determine the data range you want to pivot
Set sht = ThisWorkbook.Worksheets("Sheet1")
SrcData = sht.Name & "!" & Range("A1:R100").Address(ReferenceStyle:=xlR1C1)

'Create New Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)

'Change which Pivot Cache the Pivot Table is referring to
ActiveSheet.PivotTables("PivotTable1").ChangePivotCache (pvtCache)

End Sub


VBA設置透視錶閤計: Grand Totals

Sub PivotGrandTotals()
'PURPOSE: Show setup for various Pivot Table Grand Total options
'SOURCE: www.TheSpreadsheetGuru.com

Dim pvt As PivotTable

Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Off for Rows and Columns
pvt.ColumnGrand = False
pvt.RowGrand = False

'On for Rows and Columns
pvt.ColumnGrand = True
pvt.RowGrand = True

'On for Rows only
pvt.ColumnGrand = False
pvt.RowGrand = True

'On for Columns Only
pvt.ColumnGrand = True
pvt.RowGrand = False

End Sub


VBA設置透視錶報錶佈局:Report Layout

Sub PivotReportLayout()
'PURPOSE: Show setup for various Pivot Table Report Layout options
'SOURCE: www.TheSpreadsheetGuru.com

Dim pvt As PivotTable

Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Show in Compact Form
pvt.RowAxisLayout xlCompactRow

'Show in Outline Form
pvt.RowAxisLayout xlOutlineRow

'Show in Tabular Form
pvt.RowAxisLayout xlTabularRow

End Sub


VBA格式化透視錶的數據:Formatting A Pivot Table's Data

Sub PivotTable_DataFormatting()
'PURPOSE: Various ways to format a Pivot Table's data
'SOURCE: www.TheSpreadsheetGuru.com

Dim pvt As PivotTable

Set pvt = ActiveSheet.PivotTables("PivotTable1")

'Change Data's Number Format
pvt.DataBodyRange.NumberFormat = "#,##0;(#,##0)"

'Change Data's Fill Color
pvt.DataBodyRange.Interior.Color = RGB(0, 0, 0)

'Change Data's Font Type
pvt.DataBodyRange.Font.FontStyle = "Arial"

End Sub


VBA格式化透視錶字段數據:Formatting A Pivot Field's Data

Sub PivotField_DataFormatting()
'PURPOSE: Various ways to format a Pivot Field's data
'SOURCE: www.TheSpreadsheetGuru.com

Dim pf As PivotField

Set pf = ActiveSheet.PivotTables("PivotTable1").PivotFields("Months")

'Change Data's Number Format
pf.DataRange.NumberFormat = "#,##0;(#,##0)"

'Change Data's Fill Color
pf.DataRange.Interior.Color = RGB(219, 229, 241)

'Change Data's Font Type
pf.DataRange.Font.FontStyle = "Arial"

End Sub

VBA展開/收縮整箇字段細節:Expand/Collapse Entire Field Detail

Sub PivotField_ExpandCollapse()
'PURPOSE: Shows how to Expand or Collapse the detail of a Pivot Field
'SOURCE: www.TheSpreadsheetGuru.com
'office中國交流網翻譯
Dim pf As PivotField

Set pf = ActiveSheet.PivotTables("PivotTable1").PivotFields("Month")

'Collapse Pivot Field
pf.ShowDetail = False

'Expand Pivot Field
pf.ShowDetail = True

End Sub

分享