VBA 中数据透视表应用案例

nothingwmm

1. 
   
2. Sub Top5Customers()
   
3.     Dim WSD As Worksheet
   
4.     Dim WSR As Worksheet
   
5.     Dim WBN As Workbook
   
6.     Dim PTCache As PivotCache
   
7.     Dim PT As PivotTable
   
8.     Dim PRange As Range
   
9.     Dim FinalRow As Long
   
10.     Set WSD = Worksheets("PivotTable")
    
11.         
    
12.     '删除其他透视表
    
13.     For Each PT In WSD.PivotTables
    
14.         PT.TableRange2.Clear
    
15.     Next PT
    
16.     WSD.Range("J1:Z1").EntireColumn.Clear
    
17.         
    
18.     ' 定义输入数据以及数据源
    
19.     FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    
20.     FinalCol = WSD.Cells(1, Application.Columns.Count). _
    
21.         End(xlToLeft).Column
    
22.     Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    
23.     Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
    
24.         xlDatabase, SourceData:=PRange.Address)
    
25.    
    
26.     ' 创建数据透视表
    
27.     Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
    
28.         Cells(2, FinalCol + 2), TableName:="PivotTable1")
    
29.    
    
30.     '关闭更新
    
31.     PT.ManualUpdate = True
    
32.    
    
33.     ' 设置行列字段
    
34.     PT.AddFields RowFields:="Customer", ColumnFields:="Product"
    
35.    
    
36.     ' 设置数据字段
    
37.     With PT.PivotFields("Revenue")
    
38.         .Orientation = xlDataField
    
39.         .Function = xlSum
    
40.         .Position = 1
    
41.         .NumberFormat = "#,##0"
    
42.         .Name = "Total Revenue"
    
43.     End With
    
44.         
    
45.     ' 如果数据为空以0表示
    
46.     PT.NullString = "0"
    
47.    
    
48.     ' 根据数据排序
    
49.     PT.PivotFields("Customer").AutoSort Order:=xlDescending, _
    
50.         Field:="Total Revenue"
    
51.    
    
52.     ' 显示排名前5
    
53.     PT.PivotFields("Customer").AutoShow Type:=xlAutomatic, Range:=xlTop, _
    
54.         Count:=5, Field:="Total Revenue"
    
55.    
    
56.     PT.ManualUpdate = False
    
57.     PT.ManualUpdate = True
    
58.    
    
59.     ' 创建新的工作报表
    
60.     Set WBN = Workbooks.Add(xlWBATWorksheet)
    
61.     Set WSR = WBN.Worksheets(1)
    
62.     WSR.Name = "Report"
    
63.     ' 设置标题
    
64.     With WSR.[A1]
    
65.         .Value = "Top 5 Customers"
    
66.         .Font.Size = 14
    
67.     End With
    
68.         
    
69.     ' 复制数据
    
70.     PT.TableRange2.Offset(1, 0).Copy
    
71.     WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
72.     LastRow = WSR.Cells(Rows.Count, 1).End(xlUp).Row
    
73.     WSR.Cells(LastRow, 1).Value = "Top 5 Total"
    
74.    
    
75.     ' 返回透视表获取数据
    
76.     PT.PivotFields("Customer").Orientation = xlHidden
    
77.     PT.ManualUpdate = False
    
78.     PT.ManualUpdate = True
    
79.     PT.TableRange2.Offset(2, 0).Copy
    
80.     WSR.Cells(LastRow + 2, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
81.     WSR.Cells(LastRow + 2, 1).Value = "Total Company"
    
82.    
    
83.     ' 清除透视表
    
84.     PT.TableRange2.Clear
    
85.     Set PTCache = Nothing
    
86.    
    
87.     ' 设置一下新表的格式
    
88.     WSR.Range(WSR.Range("A3"), WSR.Cells(LastRow + 2, 6)).Columns.AutoFit
    
89.     Range("A3").EntireRow.Font.Bold = True
    
90.     Range("A3").EntireRow.HorizontalAlignment = xlRight
    
91.     Range("A3").HorizontalAlignment = xlLeft
    
92.     ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$3:$G$11"), , xlYes).Name = _
    
93.         "Table1"
    
94.     ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleDark5"
    
95.     Range("A2").Select
    
96.     MsgBox "CEO Report has been Created"
    
97. End Sub

复制代码

kewin2008

學習了！！！！

longriver_0

这个是我要的：）

gdgzlyh

学习一下！

apple_orange

先研究一下

dream_literate

好好学习，天天向上！

sadmyyz

学习一下 ,楼主威武

35524911

收了啊，谢谢！

35524911

学习了，哈哈！

wenwuxiaozi

学习               谢谢