使用AutoShow生成前5名的数据透视表！

yanjie

今天学习Bill Jelen的作品，使用VBA代码来创建。
我在文件里面做了详细说明，希望大家创建数据透视表使有用！这些代码的确是很好的学习资料，可以按F8键一步一步执行，了解数据透视表的生成过程！ AutoShow_前5名.rar (1.81 MB, 下载次数: 153)

2008-11-20 21:20 上传

点击文件名下载附件

创建数据透视表.rar (1.84 MB, 下载次数: 131)

2008-11-22 11:11 上传

点击文件名下载附件

[ 本帖最后由 yanjie 于 2008-11-22 11:11 编辑 ]

yanjie

所有代码如下（注意是本人粗浅的理解,不足之处多多指教！）
Option Explicit

Sub Top5Markets()
'定义变量！
Dim WSD As Worksheet
Dim WSR As Worksheet
Dim WBN As Workbook
Dim pt As PivotTable
Dim pc As PivotCache
Dim prange As Range
Dim Finalrow As Long
Dim Finalcol As Long
Dim lastrow As Long

'给工作表设置一个变量，便于使用。
Set WSD = Worksheets("Pivottable")      '注意名字中大小写字母没有什么区别。

'删除工作表中所有的透视表！pt.tablerange1和pt.tablerange2的区别，后者是透视表全部单元格，前者不包括页字段的单元格区域！
For Each pt In WSD.PivotTables
pt.TableRange2.Clear
Next

'清除R：AZ列的所有内容。
WSD.Range("R1:AZ1").EntireColumn.Clear

'定义变动行号和列号！
Finalrow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
Finalcol = WSD.Cells(1, Columns.Count).End(xlToLeft).Column

'设置变动数据源区域！
Set prange = WSD.Cells(1, 1).Resize(Finalrow, Finalcol)

'通过建立一个数据透视表缓存来创建透视表！需提供数据源的类型和数据源的单元格区域地址（文本）。即什么地方，什么数据源。
Set pc = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=prange.Address)

'建立透视表要求提供:透视表放在哪个单元格，什么名字！
Set pt = pc.CreatePivotTable(tabledestination:=WSD.Cells(2, Finalcol + 2), tablename:="pivottable1")

'停止透视表计算！加速代码执行速度！
pt.ManualUpdate = True

'添加行和列字段！
pt.AddFields RowFields:="Market", ColumnFields:="region"

'添加数字字段！
With pt.PivotFields("Revenue")
    .Orientation = xlDataField
    .Position = 1
    .NumberFormat = "#,##0"
    .Name = "Total Revenue"
End With

'对数字区域字段的空单元格设置为0
pt.NullString = "0"

'对字段Market进行自动排序!
pt.PivotFields("Market").AutoSort Order:=xlDescending, field:="Total Revenue"

'显示字段前5位！
pt.PivotFields("Market").AutoShow Type:=xlAutomatic, Range:=xlTop, Count:=5, field:="Total Revenue"

'计算以显示字段内容!
pt.ManualUpdate = False
pt.ManualUpdate = True

'新建一个空工作簿,一个工作表,取名Report
Set WBN = Workbooks.Add(xlWBATWorksheet)
Set WSR = WBN.Worksheets(1)
WSR.Name = "Report"

'设置A1单元格格式
With WSR.[a1]
    .Value = "Top 5 Markets"
    .Font.Size = 14
End With

'复制数据透视表到新工作簿里！
pt.TableRange2.Offset(1, 0).Copy
WSR.[a3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats

'确定新工作簿里最后一行的第一个单元格，填充为"前五位合计数"
lastrow = WSR.Cells(65536, 1).End(xlUp).Row
WSR.Cells(lastrow, 1).Value = "前五位合计数"

'这一点尤其值得学习，隐藏行字段求得合计数。我曾为这一点感到很困难！
pt.PivotFields("Market").Orientation = xlHidden
pt.ManualUpdate = False
pt.ManualUpdate = True

'偏移2行复制合计数到新工作簿最后一行
pt.TableRange2.Offset(2, 0).Copy
WSR.Cells(lastrow + 2, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
WSR.Cells(lastrow + 2, 1).Value = "Total company"

'清除数据透视表！
pt.TableRange2.Clear

'释放内存！
Set pc = Nothing

'使单元格自动适应列宽！
WSR.Range(WSR.Range("a3"), WSR.Cells(lastrow + 2, 10)).Columns.AutoFit

加粗第3行字体!
Range("a3").EntireRow.Font.Bold = True

'第3行字体靠右边设置
Range("a3").EntireRow.HorizontalAlignment = xlRight

'A3单元格靠左边对齐！
Range("a3").HorizontalAlignment = xlLeft

Range("a2").Select
MsgBox "CEO 报告创建完成"

End Sub

HUA79100101

很好。。支持版主。

cumen

正在下载 学习了。

bibisin

谢谢LZ分享

donghan

谢谢LZ分享，学习一下