Excel-VBA编程操作透视表Pivot Table代码大全
- 2021-02-12 08:00:00
- www.thespreadsheetguru.com 转贴
- 13948
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
- office课程播放地址及课程明细
- Excel Word PPT Access VBA等Office技巧学习平台
- 将( .accdb) 文件格式数据库转换为早期版本(.mdb)的文件格式
- 将早期的数据库文件格式（.mdb）转换为 （.accdb） 文件格式
- KB5002984：配置 Jet Red Database Engine 数据库引擎和访问连接引擎以阻止对远程数据库的访问（remote table)
- Access 365 /Access 2019 数据库中哪些函数功能和属性被沙箱模式阻止（如未启动宏时）
- Access Runtime(运行时)最全的下载(2007 2010 2013 2016 2019 Access 365)
- Activex控件或Dll 在某些电脑无法正常注册的解决办法(regsvr32注册时卡住）
- office使用部分控件时提示“您没有使用该ActiveX控件许可的问题”的解决方法
- RTF文件（富文本格式）的一些解析
- Access树控件（treeview) 64位Office下出现横向滚动条不会自动定位的解决办法
- Access中国树控件 在win10电脑 节点行间距太小的解决办法
- EXCEL 2019 64位版（Office 2019 64位）早就支持64位Treeview 树控件 ListView列表等64位MSCOMMCTL.OCX控件下载
- VBA或VB6调用WebService（直接Post方式）并解析返回的XML
- 早期PB程序连接Sqlserver出现错误
- MMC 不能打开文件C:/Program Files/Microsoft SQL Server/80/Tools/Binn/SQL Server Enterprise Manager.MSC 可能是由于文件不存在，不是一个MMC控制台，或者用后来的MMC版
- sql server连接不了的解决办法
- localhost与127.0.0.1区别
- Roych的浅谈数据库开发系列（Sql Server)
- sqlserver 自动备份对备份目录没有存取权限的解决办法
- 安装Sql server 2005 express 和SQLServer2005 Express版企业管理器 SQLServer2005_SSMSEE
| 联系人： | 王先生 |
|---|---|
| Email： | 18449932@qq.com |
| QQ： | 18449932 |
| 微博： | officecn01 |
