不同格式的多工作簿多工作表汇总（导入）

学不完用不尽

excel好玩 发表于 2013-6-29 22:39

正确！赞一个！

excel好玩

zhaogang1960 发表于 2013-6-29 23:25
请测试:

版主，您好，您附件里面的这句For Each sh In Sheets，应该是For Each sh In .Sheets吗？

zhaogang1960

excel好玩 发表于 2013-6-29 23:58
版主，您好，您附件里面的这句For Each sh In Sheets，应该是For Each sh In .Sheets吗？

谢谢，原帖已删除，修改如下：
不同格式的多工作薄多工作表的汇总.rar (86.5 KB, 下载次数: 157)

2013-6-30 00:02 上传

点击文件名下载附件

zhaogang1960

本题目还可以使用ADO法，有多表联合查询、ADO加数组加字典，下面是后者，速度有所提高：

1. Sub ADO加数组加字典()
   
2. '引用Microsoft Scripting Runtime
   
3. tt = Timer
   
4.     Dim cnn As New ADODB.Connection
   
5.     Dim rs As ADODB.Recordset
   
6.     Dim rst As ADODB.Recordset
   
7.     Dim SQL$, arr_Field
   
8.     Dim p$, f$, arr, brr(1 To 60000, 1 To 256), ds As Object
   
9.     Dim i&, j, m&, n&, r, y$, sh As Worksheet
   
10.     Set d = CreateObject("scripting.dictionary")
    
11.     Set ds = CreateObject("scripting.dictionary")
    
12.     ds("单位") = 1
    
13.     ds("年") = 2
    
14.     n = 2
    
15.     p = ThisWorkbook.Path & ""
    
16.     f = Dir(p & "*.xls")
    
17.     Application.ScreenUpdating = False
    
18.     Do While f <> ""
    
19.         If f <> ThisWorkbook.Name Then
    
20.             Set cnn = New ADODB.Connection
    
21.             cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & p & f
    
22.             Set rs = cnn.OpenSchema(adSchemaTables)
    
23.             Do Until rs.EOF
    
24.                 If rs.Fields("TABLE_TYPE") = "TABLE" Then
    
25.                     shn = rs("TABLE_NAME").Value
    
26.                     If Right(shn, 1) = "$" Then
    
27.                         Set rst = cnn.Execute("[" & shn & "]")
    
28.                         If rst.Fields(0).Name = "单位" Then
    
29.                             y = Left$(f, 4)
    
30.                             Set rst = New ADODB.Recordset
    
31.                             SQL = "select * from [" & shn & "] where not 单位 is null"
    
32.                             rst.Open SQL, cnn, 1, 3
    
33.                             With rst
    
34.                                 ReDim arr_Field(1 To .Fields.Count - 1)
    
35.                                 For j = 1 To .Fields.Count - 1
    
36.                                     arr_Field(j) = .Fields(j).Name
    
37.                                     If Not ds.Exists(arr_Field(j)) Then
    
38.                                         n = n + 1
    
39.                                         ds(arr_Field(j)) = n
    
40.                                     End If
    
41.                                 Next
    
42.                                 For i = 1 To .RecordCount
    
43.                                     m = m + 1
    
44.                                     brr(m, 1) = .Fields(0).Value
    
45.                                     brr(m, 2) = y
    
46.                                     For j = 1 To .Fields.Count - 1
    
47.                                         brr(m, ds(arr_Field(j))) = .Fields(j).Value
    
48.                                     Next
    
49.                                     .MoveNext
    
50.                                 Next
    
51.                             End With
    
52.                         End If
    
53.                     End If
    
54.                 End If
    
55.                 rs.MoveNext
    
56.             Loop
    
57.         End If
    
58.         f = Dir
    
59.     Loop
    
60.     Cells.ClearContents
    
61.     [a1].Resize(, n) = ds.keys
    
62.     [a2].Resize(m, n) = brr
    
63.     rs.Close
    
64.     Set rs = Nothing
    
65.     rst.Close
    
66.     Set rst = Nothing
    
67.     cnn.Close
    
68.     Set cnn = Nothing
    
69.     Application.ScreenUpdating = True
    
70.     MsgBox Timer - tt
    
71. End Sub
    

复制代码

zhaogang1960

下面附件可比较Open和ADO方法的速度：
不同格式的多工作薄多工作表的汇总1.rar (90.66 KB, 下载次数: 186)

2013-6-30 00:15 上传

点击文件名下载附件

学不完用不尽

zhaogang1960 发表于 2013-6-30 00:15
下面附件可比较Open和ADO方法的速度：

谢谢帮助，完全正确！
24小时之内的鲜花已送完，鲜花对您来说已是浮云，但我只能用鲜花来表达您对我的帮助之情，改日再送您两朵鲜花，以资鼓励！

张雄友

zhaogang1960 发表于 2013-6-30 00:15
下面附件可比较Open和ADO方法的速度：

二种方法的答案不一致。执行宏后选中整个工作表：

字典加数组的和是：66327520
ADO的和是：66327343

偏差：177

zhaogang1960

张雄友 发表于 2013-6-30 05:55
二种方法的答案不一致。执行宏后选中整个工作表：

字典加数组的和是：66327520

我这里都是66327520，请看演示：

zhaogang1960

请看附件，两种方法在两个工作表中：
不同格式的多工作薄多工作表的汇总1.rar (101.36 KB, 下载次数: 114)

2013-6-30 09:55 上传

点击文件名下载附件

张雄友

zhaogang1960 发表于 2013-6-30 09:55
请看附件，两种方法在两个工作表中：

会不会是版本原因(我用的是EXCEL2003），我把附件下载后重新执行ADO法，发现营业外支出的数据没有生成，和就是177, 问题在这里。