一文精通VBA操作透视表

Excel的透视表在我们平时的办公场景、学习以及工作中都常用到，但如果想自动化快速操作透视表，那肯定离不开VBA，但如何通过VBA自动操作透视表呢。下面列出国外一个作者有关VBA操作透视表Pivot Table代码大全，非常齐全，希望能帮助到大家。

用vba创建数据透视表可以使用PivotCaches对象的Create方法先创建一个透视表的缓存对象PivotCache

然后再用创建的PivotCache对象的CreatePivotTable方法创建PivotTable对象。

Sub CreatePivotTable()
'利用数据sheet在新sheet中创建透视表


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)


'创建一个新的sheet
Set sht = Sheets.Add


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


'从数据源创建透视表
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)


'利用缓存数据创建透视表
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1")


End Sub
复制

Sub DeletePivotTable()


'删除指定名称的透视表
ActiveSheet.PivotTables("PivotTable1").TableRange2.Clear


End Sub
复制

Sub DeleteAllPivotTables()
'删除工作簿中的所有透视表




Dim sht As Worksheet
Dim pvt As PivotTable


'循环遍历当前工作簿中所有可见的透视表
For Each sht In ActiveWorkbook.Worksheets
For Each pvt In sht.PivotTables
pvt.TableRange2.Clear
Next pvt
Next sht


End Sub
复制

Sub Adding_PivotFields()
'在透视表中添加字段






Dim pvt As PivotTable


Set pvt = ActiveSheet.PivotTables("PivotTable1")


'添加过滤条件
pvt.PivotFields("Year").Orientation = xlPageField


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


'添加行数据
pvt.PivotFields("Account").Orientation = xlRowField


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


'格式化字段
pvt.PivotFields("Year").NumberFormat = "#,##0"


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


End Sub
复制

Sub AddCalculatedField()
'在透视表中添加计算字段




Dim pvt As PivotTable
Dim pf As PivotField


'将透视表定义为变量
Set pvt = ActiveSheet.PivotTables("PivotTable1")
'将计算字段存储到变量
For Each pf In pvt.PivotFields
If pf.SourceName = "Inflation" Then Exit For
Next


'添加字段字段到透视表
pvt.AddDataField pf


End Sub
复制

Sub AddValuesField()
'透视表中添加值字段


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
复制

Sub RemovePivotField()
'从透视表中删除字段


'移除过滤器、行、列字段
ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").Orientation = xlHidden


'移除值字段
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Salaries").Orientation = xlHidden


End Sub
复制

Sub RemoveCalculatedField()
'从透视表中删除字段字段


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


'设置变量接收透视表
Set pvt = ActiveSheet.PivotTables("PivotTable1")


'设置变量接收计算字段
For Each pf In pvt.DataFields
If pf.SourceName = "Inflation" Then Exit For
Next


'隐藏或移除计算字段
pf.DataRange.Cells(1, 1).PivotItem.Visible = False


End Sub
复制

Sub ReportFiltering_Single()
'单个项目筛选透视表


Dim pf As PivotField


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


'清空筛选
pf.ClearAllFilters


'按条件2021筛选
pf.CurrentPage = "2021"


End Sub
复制

Sub ReportFiltering_Multiple()
'多条件筛选透视表


Dim pf As PivotField


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


'清空筛选
pf.ClearAllFilters


'Enable filtering on multiple items
pf.EnableMultiplePageItems = True


'关闭不需要显示的内容
pf.PivotItems("Jan").Visible = False
pf.PivotItems("Feb").Visible = False
pf.PivotItems("Mar").Visible = False


End Sub
复制

Sub ClearReportFiltering()
'清楚透视表的筛选


Dim pf As PivotField


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


'方法1：清楚所有筛选条件
pf.ClearAllFilters


'方法2：显示所有
pf.CurrentPage = "(All)"


End Sub
复制

Sub RefreshingPivotTables()
'刷新透视表的数据


'刷新单个透视表
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh


'刷新所有透视表
ActiveWorkbook.RefreshAll


End Sub
复制

Sub ChangePivotDataSourceRange()
' 修改透视表的数据源


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


'定义数据源区域
Set sht = ThisWorkbook.Worksheets("Sheet1")
SrcData = sht.Name & "!" & Range("A1:R100").Address(ReferenceStyle:=xlR1C1)


'从数据源创建透视表缓存
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)


'修改透视表缓存
ActiveSheet.PivotTables("PivotTable1").ChangePivotCache (pvtCache)


End Sub
复制

Sub PivotGrandTotals()
'设置透视表的合计方式


Dim pvt As PivotTable


Set pvt = ActiveSheet.PivotTables("PivotTable1")


'关闭行列合计
pvt.ColumnGrand = False
pvt.RowGrand = False


'打开行列合计
pvt.ColumnGrand = True
pvt.RowGrand = True


'仅行合计
pvt.ColumnGrand = False
pvt.RowGrand = True


'仅列合计
pvt.ColumnGrand = True
pvt.RowGrand = False


End Sub
复制

Sub PivotReportLayout()
'设置透视表布局属性


Dim pvt As PivotTable


Set pvt = ActiveSheet.PivotTables("PivotTable1")


'显示紧凑结构
pvt.RowAxisLayout xlCompactRow


'显示外边框
pvt.RowAxisLayout xlOutlineRow


'显示表格
pvt.RowAxisLayout xlTabularRow


End Sub
复制

Sub PivotTable_DataFormatting()
'设置透视表数据格式


Dim pvt As PivotTable


Set pvt = ActiveSheet.PivotTables("PivotTable1")


'改变数字格式
pvt.DataBodyRange.NumberFormat = "#,##0;(#,##0)"


'改变填充色
pvt.DataBodyRange.Interior.Color = RGB(0, 0, 0)


'改变字体类型
pvt.DataBodyRange.Font.FontStyle = "Arial"


End Sub
复制

Sub PivotField_DataFormatting()
'格式化透视表字段数据


Dim pf As PivotField


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


'改变数据格式
pf.DataRange.NumberFormat = "#,##0;(#,##0)"


'改变颜色
pf.DataRange.Interior.Color = RGB(219, 229, 241)


'改变字体类型
pf.DataRange.Font.FontStyle = "Arial"


End Sub
复制

Sub PivotField_ExpandCollapse()
'展开或折叠透视表字段


Dim pf As PivotField


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


'折叠
pf.ShowDetail = False


'展开
pf.ShowDetail = True


End Sub
复制

更多Excel与统计分析知识，扫码关注：全栈数据