加载中…
个人资料
微博
  • 博客等级：
  • 博客积分：
  • 博客访问：
  • 关注人气：
  • 获赠金笔：0支
  • 赠出金笔：0支
  • 荣誉徽章：
正文 字体大小：大 中 小

【教程】VBA创建数据透视表

(2015-02-15 15:10:03)
标签：

杂谈

 分类： Excel
名词解释：
  • PivotTables——数据透视表。
  • PivotCaches——数据透视表缓存。数据缓冲区，充当数据源和透视表之间的传递途径。优点：1）很大程度上控制了从数据源中获得的数据，尤其是与ADO协作时，可对外部数据源实现高级编程控制，有很大的灵活性，2）从同一数据源生成多个数据透视表（也可以使用PivotTable集合,无特别优势，只是提供丰富性选择），这比强制每个数据透视表维护自己的数据源更有效率。
  • 

      

    1. 
set pvt=Activesheet.PivotTables.add(PivotCache:=pvc,tabledestination:=range("A3"))
      2. 

    

    


    

    • 

  • PivotFields——数据透视字段。包括源数据所有字段以及已添加的计算字段（源数据表不可见）。两种技术添加：1）PivotTable.AddFields方法；addfields方法可以添加多个行字段/列字段或者页字段，添加的新字段将替换任何现有的字段，除非addtotable=true,不能用来添加或者替换数据字段。2）给PivotField对象的Orientation属性赋值。
    • 



    

  • 

    

    

      

    1. 
With Activesheet.PivotTables(1)
      2. 

    2. 
'添加新的行字段state
      3. 

    3. 
.AddFields RowFields:="state",AddToTable:=true
      4. 

    4. 
'将date字段作为新的页字段
      5. 

    5. 
.PivotFields("date").Orientation=xlPageField
      6. 

    6. 
End with
      7. 

    

    


    

    • 


    • 

  • PivotItems——数据透视项。是PivotField对象的方法而非属性，包含在字段中的唯一值。
    

    • 

  • PivotCharts——数据透视图
    • 









    

  1. 
Sub creatpivotchart()
    2. 

  2. 
Dim shp As Shape
    3. 

  3. 
'在shape对象中创建图表
    4. 

  4. 
Set shp =
activehseet.Shapes.AddChart(xlColumnStacked)
    5. 

  5. 
shp.Chart.SetSourceData
Source:=ActiveSheet.PivotTables(1).TableRange1,
PlotBy:=xlsoumns
    6. 

  6. 
'调整图表大小位置与某单元格区域相同
    7. 

  7. 
With
Range("a11:f28")
    8. 

  8. 
shp.Left = .Left
    9. 

  9. 
shp.Top = .Top
    10. 

  10. 
shp.Width = .Width
    11. 

  11. 
shp.Height = .Height
    12. 

  12. 
End With
    13. 

  13. 
'更改数据透视表和数据透视图的布局
    14. 

  14. 
With
shp.Chart.PivotLayout.PivotTable
    15. 

  15. 
.PivotFields("customer").Orientation =
xlColumnField
    16. 

  16. 
.PivotFields("product").Orientation =
xlRowField
    17. 

  17. 
End
With
    18. 

  18. 
'修改数据透视图的格式
    19. 

  19. 
shp.Chart.ChartType = xlCylinderColStacked
    20. 

  20. 
End Sub
    21. 
















Excel录制宏代码：











优化过的通用代码：














    

  1. 
Sub CreatePivotTable()
    2. 

  2. 
Dim wks As Worksheet
    3. 

  3. 
Dim pvc As PivotCache
    4. 

  4. 
Dim pvt As PivotTable
    5. 

  5. 

    6. 

  6. 
'添加新工作表
    7. 

  7. 
Set wks =
Worksheets.Add
    8. 

  8. 

    9. 

  9. 
'建立数据透视表缓存
    10. 

  10. 
Set pvc = ActiveWorkbook.PivotCaches.Create( _
    11. 

  11. 
SourceType:=xlDatabase, _
    12. 

  12. 
SourceData:=Sheet1.ListObjects("table1").Range)
'引用区域可以是range，表或者自定义名称，如名称可以写为：SourceData:="database"
    13. 

  13. 

    14. 

  14. 
'创建数据透视表，tabledestination为数据透视表的最左上方区域
    15. 

  15. 

Set pvt =
pvc.CreatePivotTable(tabledestination:=wks.Range("a3"),
_
    16. 

  16. 
defaultversion:=xlPivotTableVersion12)
    17. 

  17. 
'xlPivotTableVersion12为Excel2007及以上版本的默认模板，见XlPivotTableVersionList
枚举 (Excel)
    18. 

  18. 

    19. 

  19. 
'定义数据透视表的字段
    20. 

  20. 

    21. 

  21. 
With pvt
    22. 

  22. 
'添加行字段方法1，AddFields方法，可以跟Array函数配合使用，批量设置字段，字段名称必须跟透视表源数据的字段名字完全一样，否则会出错；可以添加页字段，行字段和列字段，不能添加数据项
    

    23. 

  23. 

    

    

    .AddFields
RowFields:=Array("客户名称", "生产单号", "类别", "运营商", "厂家", "品名", _
    

    
"匹配电源", "匹配电源口径", "产品代数", "端口数量", "其它", "调用名称单号记录"), _
    

    
PageFields:="符号"
    

    
'添加数据字段
    

    
.AddDataField .PivotFields("待测试"), "sum of 待测试", xlSum 
    

    
'添加行字段方法2，PivotFields属性，逐个设置比较麻烦
    

    

    

    24. 

  24. 
'With .PivotFields("customer")
    25. 

  25. 
'.Orientation = xlRowField
'xlColumnField
同理表示添加列字段
    26. 

  26. 
'.Position = 1 ‘position定义字段的层级，数值越大表示位置越往下（靠后）
    27. 

  27. 
'End With
    28. 

  28. 
       .RowAxisLayout
xlTabularRow '数据透视表的布局模式，PivotTable.RowAxisLayout
方法 (Excel)
    29. 

  29. 

    

    

   
    

    

    
    .RowGrand
= False '每行汇总不显示
    

    
.ColumnGrand = False '每列汇总不显示
    

    
.PivotFields("客户名称").Subtotals(1)
= False '求和汇总不显示，PivotField.Subtotals
属性 (Excel)
    

    
On Error Resume Next '错误处理
    

    
.PivotFields("符号").CurrentPage = "领"
'指定页字段，思考，找不到关键字怎么办？
    

    
.PivotFields("调用名称单号记录").PivotItems("(blank)").Visible =
False 'Visible属性隐藏项目，筛选非空值，思考，如果全为空怎么办？
    

    
    On
Error Goto 0 '用于再次打开正常的VBA错误处理，否则，将忽略更多的错误,也可以进行如下处理：
    

    

    'If ERR.Number<>0 then
'Number
属性（Err 对象）
        'ERR.Clear
    
    'End
if
    

    

    
    .CalculatedFields.Add "dianjilv", "=点击次数 /展现次数", True '添加计算字段，需要在汇总源数据之后才执行计算
    

    

    
    .AddDataField
ActiveSheet.PivotTables("PivotTable2").PivotFields("符号"), "Count of 符号", xlCount
    

    
    With
.PivotFields("Count of 符号")  
    

    

        .Caption
= "Sum of
符号" 
    

    

        .Function
= xlSum 'function属性修改数据字段的汇总方式
    

    
        .NumberFormat="0"
'设置数字的显示格式
            
    

    

    End
With
    

    

    30. 

  30. 
End With
    31. 

  31. 
End Sub
    32. 





日期分组：








    

  1. 
Sub Groupdates()
    2. 

  2. 
With
pvt
    3. 

  3. 
Set Rng = .PivotFields("date").DataRange.Cells(1,
1) 'datarange不能引用该数据区域的全部单元格
    4. 

  4. 
Rng.Group Start:=True, End:=True, _
    5. 

  5. 
periods:=Array(False, False, False, False, True, False, True) 'Start:=True, End:=True表示包含所有日期，array里面7个参数分别对应，秒/分/小时/日/月/季/年
    6. 

  6. 
End With
    7. 

  7. 
'取消分组
    8. 

  8. 
'Set Rng = .PivotFields("date").DataRange
    9. 

  9. 
'rng.ungroup
    10. 

  10. 
'重新分组
    11. 

  11. 
'Set Rng = .PivotFields("date").DataRange.Cells(1,
1)
    12. 

  12. 
'Rng.Group Start:=True, End:=True, _
    13. 

  13. 
periods:=Array(False, False, False, False, true, False, True)
    14. 

  14. 
End Sub
    15. 













探明是否出错的自定义函数：








    

  1. 
Function
bnameexists(smyname As String) As Boolean
    2. 

  2. 
Dim sname As String
    3. 

  3. 
On Error Resume Next
    4. 

  4. 
sname
= Names(smyname).RefersTo
    5. 

  5. 
If Err.Number <> 0 Then
    6. 

  6. 
bnameexists
= False
    7. 

  7. 
Err.Clear
    8. 

  8. 
Else
    9. 

  9. 
bnameexists
= True
    10. 

  10. 
End If
    11. 

  11. 
End Function
    12. 
































    

  1. 
Sub test()
    2. 

  2. 
Dim DataRng As Range '定义一个数据范围，用来储存生成数据透视表的数据
    3. 

  3. 
Dim MyPivot As
Worksheet '定义一个工作表，存放数据透视表"
    4. 

  4. 
Dim MyPivotTable As
PivotTable '定义一个数据透视表，用来储存数据透视表对象”
    5. 

  5. 
Dim MyTable As
Worksheet '定义一个工作表，做为汇总表
    6. 

  6. 
Dim sh As Worksheet
'定义工作表变量，删除数据透视表时使用
    7. 

  7. 
Set DataRng =
Range("明细表!A1:E59")
'确定生成数据透视表的数据
    8. 

  8. 
'也可以用inputbox方法选择，语句如下
    9. 

  9. 
'Set DataRng =
Application.InputBox("请选择需要生成数据透视表的数据",
Type:=8)
    10. 

  10. 
Set MyPivot =
Sheets.Add '新建一个工作表，用来存放数据透视表
    11. 

  11. 
'下面这一句是利用PivotTableWizard方法生成一个空的数据透视表；
    12. 

  12. 
Set MyPivotTable =
MyPivot.PivotTableWizard(SourceType:=xlDatabase,
SourceData:=DataRng)
    13. 

  13. 
'添加数据透视表行字段和列字段，如果需要同时添加多个行字段或者列字段，用arr函数
    14. 

  14. 
MyPivotTable.AddFields
RowFields:=Array("BH", "XM"),
ColumnFields:="MC"
    15. 

  15. 
'添加数据透视表数据字段和汇总方法，注意这里需要写完整数据字段“MyPivotTable.PivotFields("JE")”
    16. 

  16. 
MyPivotTable.AddDataField
MyPivotTable.PivotFields("JE"),
Function:=xlSum
    17. 

  17. 
'去掉BH字段中分类汇总功能，Subtotals(1)=false代表将索引 1（自动）为
false，则其他所有值将设置为 False。如果需要分类汇总功能，则设置为true或不要这句；
    18. 

  18. 
MyPivotTable.PivotFields("BH").Subtotals(1) =
False
    19. 

  19. 
'建一个新表，将所需内容copy到新表
    20. 

  20. 
Set MyTable =
Sheets.Add
    21. 

  21. 
Range(MyPivot.Cells.Find("BH"),
MyPivot.UsedRange.Item(MyPivot.UsedRange.Count)).Copy
MyTable.Range("A1")
    22. 

  22. 
'以下内容是将新表改为汇总表，如果有汇总表存在，则弹出提示
    23. 

  23. 
On Error GoTo
ErrorHandler
    24. 

  24. 
MyTable.Name =
"汇总表"
    25. 

  25. 
ErrorHandler:
    26. 

  26. 
If Err.Number = 1004
Then
    27. 

  27. 
MsgBox
"汇总表已存在"
    28. 

  28. 
'删除生成的数据透视表
    29. 

  29. 
Application.DisplayAlerts = False
    30. 

  30. 
For Each sh In
Worksheets
    31. 

  31. 
If sh.Name Like
"Sheet*" Then sh.Delete
    32. 

  32. 
Next
    33. 

  33. 
Application.DisplayAlerts = True
    34. 

  34. 
Else
    35. 

  35. 
'删除生成的数据透视表
    36. 

  36. 
Application.DisplayAlerts = False
    37. 

  37. 
For Each sh In
Worksheets
    38. 

  38. 
If sh.Name Like
"Sheet*" Then sh.Delete
    39. 

  39. 
Next
    40. 

  40. 
Application.DisplayAlerts = True
    41. 

  41. 
End
If
    42. 

  42. 
End
Sub
    43. 
















案例研究：




调用记录







 






    

  1. 

    2. 









 





以下内容摘录国外一本书上：



一.用数据透视表向导创建透视表的方法：



 






    

  1. 
Worksheets(“Sheet2”).PivotTableWizard SourceType:=xlDatabase,SourceData:=Range(“Sheet1!A4:E250”)
    2. 









用PivotTableWizard方法，创建一个透视表，2个参数，一个SourceType数据源类型，采用excel数据库；另外一个SourceData数据源，采用工作表Sheet1!A4:E250单元格区域，透视表的放置位置在当前活动的单元格。



当然，你也可以给数据透视表指定放置的详细位置，例如，把它放在D4单元格，透视表命名为:=”My Pivot
Table”，代码变为：



 






    

  1. 
Worksheets(“Sheet2”).PivotTableWizard SourceType:=xlDatabase, SourceData:=Range(“Sheet1!A4:E250”), _
    2. 

  2. 
TableDestination:=Range(“D4”), TableName:=”My Pivot Table”
    3. 









最后，你还可以指定“行合计”和“列合计”，则代码变为:



 






    

  1. 
Worksheets(“Sheet2”).PivotTableWizard SourceType:=xlDatabase, SourceData:=Range(“Sheet1!A4:E250”), _
    2. 

  2. 
TableDestination:=Range(“D4”),TableName:=”My Pivot Table”, _
    3. 

  3. 
RowGrand:=True, ColumnGrand:=True
    4. 









我们一般使用3个参数即可，其它的省略：



 






    

  1. 
Worksheets(“Sheet2”).PivotTableWizard SourceType:=xlDatabase, _
    2. 

  2. 
SourceData:=Range(“Sheet1!A4:C28”),TableDestination:=Range(“B2”)
    3. 









二.用PivotCache透视表内存缓存创建一个数据透视表：



 






    

  1. 
Public
Sub CreatePivotTable()
    2. 

  2. 
Dim wb As Workbook ’声明3个变量！
    3. 

  3. 
Dim pt As PivotTable
    4. 

  4. 
Dim pc As PivotCache
    5. 

  5. 
On Error GoTo ErrorHandler
    6. 

  6. 
‘ Open the workbook.即设置打开一个工作簿的变量。
    7. 

  7. 
Set wb = Workbooks.Open(“c:\PivotData\VideoStoreRawData.xls”)
    8. 

  8. 
‘ Create the PivotCache.创建一个透视表内存缓存！
    9. 

  9. 
Set pc = wb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=”[VideoStoreRawData.xls]Sheet1!A4:C28”)
    10. 

  10. 
‘ 采用CreatePivotTable方法，利用透视表缓存创建一个数据透视表！
    11. 

  11. 
Set pt = pc.CreatePivotTable TableDestination:=”[VideoStoreRawData.xls]Sheet2! “,TableName:=”Video Data”
    12. 

  12. 
‘下面是错误处理程序，可以借鉴一下，很常用的方法！
    13. 

  13. 
wb.Worksheets(“Sheet2”).Activate
    14. 

  14. 
EndOfSub:
    15. 

  15. 
Exit
Sub
    16. 

  16. 
ErrorHandler:
    17. 

  17. 
If Err.Number = 5 Or Err.Number = 9 Then
    18. 

  18. 
MsgBox
“The file could not be found”
    19. 

  19. 
ElseIf
Err.Number = 1004 Then
    20. 

  20. 
MsgBox
“There
is already a
PivotTable at that
location”
    21. 

  21. 
Else
    22. 

  22. 
MsgBox
“Error
“ & Err
& “ - “ &
Err.Description
    23. 

  23. 
End If
    24. 

  24. 
Resume
EndOfSub
    25. 

  25. 
End Sub
    26. 









 



以上2种方法，创建出一个奇怪的4个单元格形状的数据透视表，透视表中没有任何字段！



下面是添加行字段，列字段和页字段的方法：



用Addfields方法，来添加，它的语法是：



AddFields(RowFields, ColumnFields, PageFields, _ AddToTable)



如果你只添加一个字段，例如：



 






    

  1. 
Worksheets(“Sheet1”).PivotTables(1).AddFields _
    2. 

  2. 
(ColumnFields:=”Region”, AddToTable:=True)
    3. 









如果添加多个字段，则用Array来添加：



 






    

  1. 
myPivotTable.AddFields(RowFields:=Array(“Status”, “DueDate”))
    2. 









下面的代码是一个完整的例子，包括行，列和页字段的添加：



 






    

  1. 
myPivotTable.AddFields(RowFields:=”Region”, _
    2. 

  2. 
ColumnFields:=”Quarter”, _
    3. 

  3. 
PageFields:=Array(“Status”, “DueDate”))
    4. 









 



下面继续介绍向数据区域添加数据字段的方法：



如果你只添加一个数据字段，则用AddDataField方法，它的语法是：



AddDataField(Field,Caption,Function)



Field参数的表示方法：PivotFields(Name)



例子如下：



 






    

  1. 
Dim pt As PivotTable
    2. 

  2. 
Set pt = Worksheets(“Sheet1”).PivotTables(“PivotTable1”)
    3. 

  3. 
pt.AddDataField pt.PivotFields(“Sales”), “Total Sales”
    4. 









下面是一个创建数据透视表的完整例子：



 






    

  1. 
Public
Sub CreateCompletePivotTable()
    2. 

  2. 
Dim wb As Workbook
    3. 

  3. 
Dim pt As PivotTable
    4. 

  4. 
On Error GoTo ErrorHandler
    5. 

  5. 
‘ Open the workbook.
    6. 

  6. 
Set wb = Workbooks.Open(“c:\PivotData\VideoStoreRawData.xls”)
    7. 

  7. 
‘ Create the PivotTable and get a reference to
it.
    8. 

  8. 
Set pt = Worksheets(“Sheet2”).PivotTableWizard(SourceType:=xlDatabase, _
    9. 

  9. 
SourceData:=Range(“Sheet1!A4:C28”), _
    10. 

  10. 
TableDestination:=Range(“Sheet2!B2”))
    11. 

  11. 
‘ Add row and column fields.
    12. 

  12. 
pt.AddFields RowFields:=”Store”, ColumnFields:=”Category”
    13. 

  13. 
‘ Add data field.
    14. 

  14. 
pt.AddDataField pt.PivotFields(“Titles”), “Total Titles”
    15. 

  15. 
EndOfSub:
    16. 

  16. 
Exit
Sub
    17. 

  17. 
ErrorHandler:
    18. 

  18. 
If Err.Number = 5 Or Err.Number = 9 Then
    19. 

  19. 
MsgBox
“The file could not be found”
    20. 

  20. 
ElseIf
Err.Number = 1004 Then
    21. 

  21. 
MsgBox
“There
is already a
PivotTable at that
location”
    22. 

  22. 
Else
    23. 

  23. 
MsgBox
“Error
“ & Err
& “ - “ &
Err.Description
    24. 

  24. 
End If
    25. 

  25. 
Resume
EndOfSub
    26. 

  26. 
End Sub
    27. 










 


？

















 




















							
		

						
		

        	
            

	        	

	            	

	                
喜欢

	            


                                

                    
0

                    
                

                
	        

            

		

		

			
			

				阅读┊ 
								收藏
								┊
				喜欢▼
									┊打印┊举报/Report
											

			

				

					

					

									

			

		

		

		
		
		

							
		

				

		
				
	

	
		

            
       
            

          



	
	
	
	
  

	

	
    

   
  

	

    

      
      
新浪BLOG意见反馈留言板　欢迎批评指正

   
      
新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑 

      
 Copyright © 1996 - 2022 SINA Corporation,  All Rights Reserved

      
 新浪公司 版权所有