VBA实现Excel的数据透视表

前言

本节会介绍通过VBA的PivotCaches.Create方法实现Excel创建新的数据透视表、修改原有的数据透视表的数据源以及刷新数据透视表内容。
本节测试内容以下表信息为例
在这里插入图片描述


1、创建数据透视表

语法:PivotCaches.Create(SourceType, [SourceData], [Version])
说明:

SourceType:必填参数,可以是以下 XlPivotTableSourceType 常量之一: xlConsolidation、 xlDatabase 或 xlExternal
SourceData:非必填,新数据透视表缓存的数据。
Version:版本,非必填,可以是常量xlPivotTableVersion2000,对应Excel 2000,也可以是xlPivotTableVersion10、xlPivotTableVersion11、xlPivotTableVersion12、xlPivotTableVersion14、xlPivotTableVersion15分别表示Excel 2002、2003、2007、2010、2013

示例:

根据上表内容,在原sheet2上创建一个数据透视表,起始位置为J1,透视表设置行为名称、产品编号,列设置为生产年月,值为销售数量求和,完整的代码如下:

Sub CreatePivot()
    
    ' 声明工作簿、工作表变量
    Dim wb As Workbook
    Dim ws As Worksheet
    ' 声明数据源、透视表目标起始位置、数据透视表变量
    Dim dataSource As Range
    Dim datePivot As Range
    Dim newPivot  As PivotTable
    
    '设置工作簿为当前文件
    Set wb = ThisWorkbook
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    
    ' 通过A列获取最大行数
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 定义数据源范围
    Set dataSource = ws.Range("A1:F" & lastRow)
    ' 定义透视表目的起始位置
    
    ' 创建一个新的数据透视表
    Set newPivot = wb.PivotCaches.Create(xlDatabase, dataSource).CreatePivotTable(ws.Range("J1"), "PivotTable123")
    
    ' 定义透视表的行列值
    With newPivot
        .PivotFields("名称").Orientation = xlRowField
        .PivotFields("商品编号").Orientation = xlRowField
        .PivotFields("生产年月").Orientation = xlColumnField
        With .PivotFields("销售数量")
            .Orientation = xlDataField
            .Function = xlSum
        End With
    End With
      
End Sub

代码说明:
注意 PivotCaches.Create 是用在workbook后面的方法属性
CreatePivotTable 用来指定创建的透视表的位置以及透视表的名称,若想要在一张新的工作表创建,如想在sheet3中创建,则可以将上述代码中的ws.Range(“J1”)改为ThisWorkbook.Worksheets(“Sheet3”).Range(“A1”),前提是该工作簿中存在Sheet3工作表

在这里插入图片描述

2. 修改数据透视表的数据源

如上例类似,修改已有的数据透视表的数据源,修改为A1:F20,完整的代码如下:

Sub UpdatePivotSourceData()

    ' 声明工作簿、工作表变量
    Dim wb As Workbook
    Dim ws As Worksheet
    ' 声明数据源、透视表目标起始位置、数据透视表变量
    Dim dataSource As Range
    Dim datePivot As Range
    Dim pt As PivotTable
    
    '设置工作簿为当前文件
    Set wb = ThisWorkbook
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    
    ' 设置要修改的数据透视表名称
    Set pt = ws.PivotTables("PivotTable123")
    
    ' 修改数据透视表的数据范围
    pt.sourceData = ws.Range("A1:F20").Address(True, True, xlR1C1, True)
    
    ' 刷新数据透视表
    pt.RefreshTable

End Sub

在这里插入图片描述

3. 刷新数据透视表

pt.RefreshTable
pt表示对应的数据透视表,如以下代码:

Sub RefreshPivot
	Dim pt As PivotTable
	Dim ws As Worksheet

	Set ws = ThisWorkbook.Worksheets("Sheet2")
	' 设置要修改的数据透视表名称
    Set pt = ws.PivotTables("PivotTable123")

	' 刷新数据透视表
    pt.RefreshTable
    
End Sub

对应的数据透视表名称
在这里插入图片描述

SQL+数据透视表+VBA 使数据透视表走向更灵活,更智能,更适用。 这个是我和师傅一撇首度合作,他提供了文件并提出了要求,我帮他实现其效果 下面从几个方面解释一下: 1、功能 一个源文件和一个通过用SQL查询生成的数据透视表 将源文件拖到电脑的任意位置,甚至将文件名也改掉,用VBA配上代码和窗体找到文件,数据透视表仍然能够正常工作 2、套用 现在来讲讲怎么使做出来的东东适应大家的需要 2、1 用OLE DB窗口引用工作表或写SQL语句,因为用这个方法同VBA相通,copy下来代码区的的语句 2、2 打开透视表文件,将透视表中的字段全部拖出来,也就是变成一个空数据透视表。 右击下面工作表图标 或者 工具》宏》visual basic 编辑器,点击模块看到代码区 2、3 将2、1步骤copy的语句commandtext的数据Array中的引号中 .CommandText = Array(" ") 可能不同版本会有一些差别,同时SQL语句中如果添加了文本生成新字段,双引号要成对翻倍 如:"出库" AS 表单选项 要改成 ""出库"" AS 表单选项 2、4 语句太长的处理:在代码区如果你想好看一些,你可以插入“ _”来换行,当然不能插在一个单词或自动名等中间。 2、5 将文件存盘,重新打开就会有了数据,你可以将字段拖入数据透视表中,创建你自己的数据透视表, 2、6 这样文件就可以使用,相信VBA的引导不用教就可以交给别人使用了 下面附上代码,包含3个区: 1、 工作簿去,打开文件时工作 Private Sub Workbook_Open() Dim OP If Dir(Sheets("path").Range("A1")) = "" Then OP = MsgBox("源文件已被移走,请选择下列选项" + Chr(10) + "1、选择是,重新输入文件全名" + Chr(10) + "2、选择否,打开原有的数据透视表" + Chr(10) + "3、选择取消,关闭文件", vbYesNoCancel, "Scarlett温馨提示") If OP = vbYes Then UserForm1.Show End If If OP = vbNo Then ActiveWorkbook.Close True End If If OP = vbCancel Then Exit Sub End If Else Call refreshpv End If End Sub 2、窗体区,实现文件的查找 Private Sub CommandButton1_Click() Dim fopen As FileDialog Set fopen = Application.FileDialog(msoFileDialogFilePicker) fopen.Show TextBox1.Value = fopen.SelectedItems(1) Set fopen = Nothing End Sub Private Sub CommandButton2_Click() If InStr(TextBox1.Value, ".") > 0 Then Sheets("path").Range("A1") = TextBox1.Value Call refreshpv unload me Else MsgBox "文件名要带路径含后缀的文件名", "Scarlett_88温馨提示" TextBox1.SetFocus End If End Sub Private Sub CommandButton3_Click() Unload Me End Sub Private Sub TextBox1_Change() End Sub Private Sub UserForm_Activate() End Sub Private Sub UserForm_Click() TextBox1.Value = Sheets("path").Range("A1") End Sub 3、模块区,实现SQL语句的地址更新和刷新数据透视表的数据源 Sub refreshpv() With ActiveSheet.PivotTables("数据透视表1").PivotCache .Connection = Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Sourc
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值