《VBA创建透视表代码.pdf》由会员分享，可在线阅读，更多相关《VBA创建透视表代码.pdf（3页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、一、VBA 读取 excel：Sub LoadExcelData()Dim wkbk As Workbook 定义一个工作薄Dim myFileName As String 定义要读取的文件路径Dim rgA1 As String定义要读取的单元格A1 Dim rgB10 As String定义要读取的单元格B10 myFileName=Application.GetOpenFilename(EXCEL文件(*.xls),*.xls)浏览文件，如 XX 公司 08 年 XX 表.xls If myFileName=False Then 如果按取消那么弹出对话框MsgBox 请选择文件!,vbI
2、nformation,取消 Else Set wkbk=Workbooks.Open(myFileName)先打开要复制的文件wkbk.Activate激活打开工作簿Sheets(Sheet1).Activate 如果提示下标越界，可以使用 Sheets(1).Activate rgA1=Cells(1,1)取得 A1 Sheets(Sheet2).Activate rgB10=Cells(10,2)取得 B10 wkbk.Close False 关闭工作薄Cells(2,1)=rgA1给目标格赋值 A2 Cells(3,1)=rgB10给目标格赋值A3 MsgBox 文件导入成功，请保存该文
3、件！End If End If End Sub 二、VBA 创建透视表Sub test()Dim DataRng As Range 定义一个数据范围，用来储存生成数据透视表的数据Dim MyPivot As Worksheet 定义一个工作表，存放数据透视表 Dim MyPivotTable As PivotTable 定义一个数据透视表，用来储存数据透视表对象”Dim MyTable As Worksheet 定义一个工作表，做为汇总表Dim sh As Worksheet 定义工作表变量，删除数据透视表时使用Set DataRng=Range(明细表!A1:E59)确定生成数据透视表的数据
4、也可以用inputbox 方法选择，语句如下Set DataRng=Application.InputBox(请选择需要生成数据透视表的数据,Type:=8)Set MyPivot=Sheets.Add 新建一个工作表，用来存放数据透视表下面这一句是利用PivotTableWizard方法生成一个空的数据透视表；Set MyPivotTable=MyPivot.PivotTableWizard(SourceType:=xlDatabase,SourceData:=DataRng)添加数据透视表行字段和列字段，如果需要同时添加多个行字段或者列字段，用arr 函数MyPivotTable.AddF
5、ields RowFields:=Array(BH,XM),ColumnFields:=MC 添加数据透视表数据字段和汇总方法，注意这里需要写完整数据字段“MyPivotTable.PivotFields(JE)”MyPivotTable.AddDataField MyPivotTable.PivotFields(JE),Function:=xlSum 去掉 BH 字段中分类汇总功能，Subtotals(1)=false代表将索引1（自动）为false，则其他所有值将设置为False。如果需要分类汇总功能，则设置为true 或不要这句；MyPivotTable.PivotFields(BH).
6、Subtotals(1)=False 建一个新表，将所需内容copy 到新表Set MyTable=Sheets.Add Range(MyPivot.Cells.Find(BH),MyPivot.UsedRange.Item(MyPivot.UsedRange.Count).Copy MyTable.Range(A1)以下内容是将新表改为汇总表，如果有汇总表存在，则弹出提示On Error GoTo ErrorHandler MyTable.Name=汇总表 ErrorHandler:If Err.Number=1004 Then MsgBox 汇总表已存在 删除生成的数据透视表Application.DisplayAlerts=False For Each sh In Worksheets If sh.Name Like Sheet*Then sh.Delete Next Application.DisplayAlerts=True Else 删除生成的数据透视表Application.DisplayAlerts=False For Each sh In Worksheets If sh.Name Like Sheet*Then sh.Delete Next Application.DisplayAlerts=True End If End Sub