[已解决]ado汇总分析工作簿数据

mn860429

附件中只是汇总了数据，可以通过ado直接得到分析结果吗？

work.rar (23.24 KB, 下载次数: 88)

2011-3-10 13:28 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

阿童木

2011-3-10 13:54

送你个一步到位的。

1. Sub CommandButton1_Click()
   
2.     Dim MySQL As String, i As Long, k As Integer, shts As Integer, works As Integer
   
3.     Dim MyCnn, rs, arr()
   
4.     Dim Sht As Worksheet
   
5.     Set MyCnn = CreateObject("adodb.connection")
   
6.     Application.ScreenUpdating = False
   
7.     Columns("a:f").Clear
   
8.     '选取文件窗口
   
9.     Filename = Application.GetOpenFilename("Microsoft Office Excel Files (*.xls), *.xls", , "请选取文件", , MultiSelect:=True)
   
10.     If Not IsArray(Filename) Then Exit Sub
    
11.     works = UBound(Filename)
    
12.     '工作簿循环
    
13.     For k = 1 To works
    
14.         With Workbooks.Open(Filename(k))
    
15.             '通过循环得到工作簿的sql语句
    
16.             For Each Sht In .Worksheets
    
17.                 shts = shts + 1
    
18.                 ReDim Preserve arr(1 To shts)
    
19.                 arr(shts) = "select * from [Excel 8.0;Database=" & Filename(k) & "].[" & Sht.Name & "$]"
    
20.             Next Sht
    
21.             '执行查询
    
22.             .Close
    
23.         End With
    
24.     Next k
    
25.     MySQL = "Select 姓名,SUM(工资) as 工资 From (" & Join(arr, " Union All ") & ") Group By 姓名"
    
26.     MyCnn.Open ("provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & Filename(1))
    
27.     Sheet1.Range("A2").CopyFromRecordset MyCnn.Execute(MySQL)
    
28.     MyCnn.Close
    
29.     Set MyCnn = Nothing
    
30.     Range("a1:b1").Value = Array("姓名", "工资")
    
31.     Application.ScreenUpdating = True
    
32. End Sub

复制代码

跳转到最佳答案楼层

阿童木

再自查询一下不就行了

mn860429

回复 阿童木 的帖子

怎么写呢

我是每循环一个工作簿就把查询的结果返回了单元格{:091:}，不知道怎么该通过什么方法达到下面语句的效果{:091:}
select 姓名,sum(工资) from (工作簿1查询语句的结果 union all 工作簿2查询语句的结果 union al工作簿3查询语句的结果 union all ****) group by 姓名

阿童木

送你个一步到位的。

1. Sub CommandButton1_Click()
   
2.     Dim MySQL As String, i As Long, k As Integer, shts As Integer, works As Integer
   
3.     Dim MyCnn, rs, arr()
   
4.     Dim Sht As Worksheet
   
5.     Set MyCnn = CreateObject("adodb.connection")
   
6.     Application.ScreenUpdating = False
   
7.     Columns("a:f").Clear
   
8.     '选取文件窗口
   
9.     Filename = Application.GetOpenFilename("Microsoft Office Excel Files (*.xls), *.xls", , "请选取文件", , MultiSelect:=True)
   
10.     If Not IsArray(Filename) Then Exit Sub
    
11.     works = UBound(Filename)
    
12.     '工作簿循环
    
13.     For k = 1 To works
    
14.         With Workbooks.Open(Filename(k))
    
15.             '通过循环得到工作簿的sql语句
    
16.             For Each Sht In .Worksheets
    
17.                 shts = shts + 1
    
18.                 ReDim Preserve arr(1 To shts)
    
19.                 arr(shts) = "select * from [Excel 8.0;Database=" & Filename(k) & "].[" & Sht.Name & "$]"
    
20.             Next Sht
    
21.             '执行查询
    
22.             .Close
    
23.         End With
    
24.     Next k
    
25.     MySQL = "Select 姓名,SUM(工资) as 工资 From (" & Join(arr, " Union All ") & ") Group By 姓名"
    
26.     MyCnn.Open ("provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & Filename(1))
    
27.     Sheet1.Range("A2").CopyFromRecordset MyCnn.Execute(MySQL)
    
28.     MyCnn.Close
    
29.     Set MyCnn = Nothing
    
30.     Range("a1:b1").Value = Array("姓名", "工资")
    
31.     Application.ScreenUpdating = True
    
32. End Sub

复制代码

mn860429

偶像啊{:221:}

mn860429

回复 阿童木 的帖子

mycnn的datasource不是第一个工作簿吗？

是不是如果sql语句where定义了完整的地址,则这个sql语句即使和mycnn的datasource是不同的也是可以被执行的？

阿童木

mn860429 发表于 2011-3-10 14:12
回复 阿童木 的帖子

mycnn的datasource不是第一个工作簿吗？

在SQL中，只要标注了数据库的完整地址和类型，当前连接是个完全不相干的文件也没关系。