ADO分别创建Excel\Access\SQLServer数据源透视表

fankairong · 发表于 2012-7-21 22:38

本帖最后由 fankairong 于 2012-7-21 22:47 编辑

数据透视表绝对是Excel数据分析的最强大工具(没有之一);但同时限于Excel本身的局限,日常工作中更多的数据源都是存在类似Access\SQL Server等数据库中.在这种情况下,我们应该如何发挥数据透视表的优势呢?或许你会说可以用外部数据源\MQ等,但他们都存在不少的明显缺点,比如条件判断,变量使用等等,那如果直接用VBA来创建数据透视表呢?那不就可以完美解决以上问题了吗?
接下来就分别以最常用的三种数据源来举例说明.

ADO透视表.rar (595.99 KB, 下载次数: 903)
1\Excel数据源
关键点:表名需要以$结尾,如[订单$],日期标识符为#

Private Sub 以Excel为数据源创建透视表()
Dim mySQL As String
Dim mycnn
Dim wsh As Worksheet
Set wsh = Worksheets("Excel为数据源透视表")
Set mycnn = CreateObject("ADODB.connection")

Dim pt As PivotCache

'删除旧的数据透视表,以免接下来新建时出错
On Error Resume Next
wsh.PivotTables("数据透视表1").TableRange2.Delete

'建立链接
Set mycnn = CreateObject("adodb.connection")
mycnn.Open ("provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName)

mySQL = "SELECT `订单$`.订单ID, `订单$`.客户, `订单$`.雇员, `订单$`.订购日期, `订单$`.到货日期, `订单$`.发货日期, `订单$`.运货商, `订单$`.运货费, `订单$`.货主名称,"
mySQL = mySQL & " `订单$`.货主地址, `订单$`.货主城市, `订单$`.货主地区, `订单$`.货主邮政编码, `订单$`.货主国家, `订单明细$`.产品, `订单明细$`.单价, `订单明细$`.数量, `订单明细$`.折扣"
mySQL = mySQL & " FROM `订单$` `订单$`, `订单明细$` `订单明细$` WHERE `订单$`.订单ID = `订单明细$`.订单ID and 发货日期>=#1997-1-1# " '建立透视表缓存

Set pt = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set pt.Recordset = mycnn.Execute(mySQL)
pt.CreatePivotTable TableDestination:=wsh.Range("a3"), TableName:="数据透视表1"

'透视表布局
With wsh.PivotTables("数据透视表1")
      .PivotFields("产品").Orientation = xlRowField
      .PivotFields("产品").Position = 1
      .AddDataField wsh.PivotTables("数据透视表1").PivotFields("数量"), "数量合计", xlSum
End With
'清空对象
mycnn.Close
Set mycnn = Nothing
End Sub

fankairong · 发表于 2012-7-21 22:41

2\Access数据源
关键点:表名不需要以$结尾,可直接使用表名,在这部分基本上市面上的SQL语法书里的内容都可以直接使用

Sub 以Access为数据源创建透视表()
Dim sht As Worksheet
Set sht = Worksheets("Access透视表")
Application.ScreenUpdating = False
On Error Resume Next
Worksheets("sht").TableRange2.Delete
'-----------------------------------------------------------------------
'用ADO建立数据连接，用Sql提取数据，把所得数据提供给新建的数据透视表高速缓存
'然后关闭连接,释放对象空间
Set conn = CreateObject("ADODB.Connection")
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\Northwind.mdb" '连接2003及以下版本
'conn.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\Northwind.accdb" '2007及以上版本
Sql = "select * from 订单 where 发货日期 between #1996-1-1# and #1998-12-1#" '与以Excel为数据源的区别是表名不用加$
' 创建透视表高速缓存及创建透视表
Dim objPivotCache As PivotCache
Set objPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set objPivotCache.Recordset = conn.Execute(Sql)
With objPivotCache
.CreatePivotTable TableDestination:=sht.Range("A3"), TableName:="数据透视表1"
End With
'透视表布局
With wsh.PivotTables("数据透视表1")
.PivotFields("产品").Orientation = xlRowField
.PivotFields("产品").Position = 1
.AddDataField wsh.PivotTables("数据透视表1").PivotFields("数量"), "数量合计", xlSum
End With
'清空对象
conn.Close
Set conn = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

fankairong · 发表于 2012-7-21 22:42

3\SQL Server数据源
关键点:表名不需以$结尾,但日期标识符不是#,而是'

Sub 以SQLServer为数据源创建透视表()
'-----------------------------------------------------------------------
'用VBA操作ADO+SQL+数据透视表（Pivot）的综合运用
Application.ScreenUpdating = False
Dim sht As Worksheet
Set sht = Worksheets("SQLServer数据透视表")
On Error Resume Next
sht.PivotTables("数据透视表1").TableRange2.Delete
'用ADO建立数据连接，用Sql提取数据，把所得数据提供给新建的数据透视表高速缓存
'然后关闭连接,释放对象空间
Set conn = CreateObject("ADODB.Connection")
conn.Open "provider=SQLOLEDB.1;User ID=sa;Password=admin;Data Source=192.168.0.168;Initial Catalog=NorthWind" 'SQL Server
Sql = "select * from 订单明细 where 开票日期>='1996-1-1' and 开票日期<='1998-1-1'" '区别最大在于日期的标识符是英文逗号而不是井字号
' 创建透视表高速缓存及创建透视表
Dim objPivotCache As PivotCache
Set objPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set objPivotCache.Recordset = conn.Execute(Sql)
With objPivotCache
.CreatePivotTable TableDestination:=sht.Range("A3"), TableName:="数据透视表1"
End With
conn.Close
Set conn = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

以上仅当抛砖引玉,基本内容都可直接引用,只有把握住关键点,然后根据自己的实际情况编写SQL语句即可自由自在的享受数据透视表的强大功能了!

turan21 · 发表于 2012-7-29 18:25

非常好的模版,非常感谢{:soso_e163:}{:soso_e100:}

fankairong · 发表于 2012-7-31 21:22

本帖最后由 fankairong 于 2012-7-31 21:22 编辑

从有密码的Mdb里取数,以给一位朋友解答为例
http://club.excelhome.net/forum. ... =900372&pid=6170608

Sub 从Access中取数()
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\database\backup.mdb ;Persist Security Info=False;Jet OLEDB:Database Password=jpdy61046"
Sql = "select top 1 skm from T66FPMX"
Worksheets("往来票据").[M4].CopyFromRecordset conn.Execute(Sql)
conn.Close
Set conn = Nothing
End Sub

复制代码

xujilong1 · 发表于 2012-8-1 20:24

fankairong 发表于 2012-7-21 22:41
2\Access数据源
关键点:表名不需要以$结尾,可直接使用表名,在这部分基本上市面上的SQL语法书里的内容都可以 ...

可不可以详细说明下具体操作步骤？具体这个代码将写在哪里呢？

ya00001 · 发表于 2012-8-5 10:13

学习了，楼主真牛啊

fankairong · 发表于 2012-8-6 09:51

amiaosheng 发表于 2012-8-5 20:40
楼主，我下了一楼的附件，感觉非常强大。
由于本人基础薄弱，现在用高级筛选+表，生成的透视 ...

看过你的附件，但是不明白您是需要我帮你做什么呢？

amiaosheng · 发表于 2012-8-5 20:40

本帖最后由 amiaosheng 于 2012-8-5 21:11 编辑

楼主，我下了一楼的附件，感觉非常强大。{:soso_e179:}
由于本人基础薄弱，现在用高级筛选+表，生成的透视表使用起来不是很方便（尤其日期无法进行自动组合，不得已我又用辅助列增加了年、月{:soso_e127:}）。
想请您帮我把附件中订单执行统计表按您一楼的模板优化一下，不甚感激！
Ps：除了删除其中数据，表单的格式和数据类型我一点都没变。

订单执行统计表.rar (8.05 KB, 下载次数: 86)

amiaosheng · 发表于 2012-8-6 13:10

fankairong 发表于 2012-8-6 09:51
看过你的附件，但是不明白您是需要我帮你做什么呢？

创建数据透视表供分析使用，透视表字段用VBA从Excel数据源中生成。

		自动登录	找回密码
密码			免费注册

ADO分别创建Excel\Access\SQLServer数据源透视表

评分

评分