请各位大神帮忙把同一文件夹下其它工作簿文件汇总，谢谢

tzx021305

日报大多，请帮忙写代码汇总，谢谢！

LMY123

ADO同夹多薄首表合并成一薄一表

1. 'http://club.excelhome.net/thread-1101782-1-1.html
   
2. Sub ADO加数组()
   
3. tt = Timer
   
4.     Dim cnn As Object, SQL$, Mypath$, MyName$, arr, brr(1 To 60000, 0 To 28), i&, j&, m&
   
5.     Application.ScreenUpdating = False
   
6.     Mypath = ThisWorkbook.Path & "/"
   
7.     MyName = Dir(Mypath & "*.xls")
   
8.     Do While MyName <> ""
   
9.         If InStr(MyName, ThisWorkbook.Name) = 0 Then
   
10.             Set cnn = CreateObject("ADODB.Connection")
    
11.             cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no';Data Source=" & Mypath & MyName
    
12.             Set rs = cnn.OpenSchema(20)
    
13.             Do Until rs.EOF '该Do循环将查找工作簿中的所有工作表，如果仅取一个工作表，请说明该表的特征
    
14.                 If rs.Fields("TABLE_TYPE") = "TABLE" Then
    
15.                     s = Replace(rs("TABLE_NAME").Value, "'", "")
    
16.                     If Right(s, 1) = "$" Then
    
17.                         SQL = "select * from [$a2:AC] where f2 is not null"
    
18.                         arr = cnn.Execute(SQL).GetRows
    
19.                         For i = 0 To UBound(arr, 2)
    
20.                             m = m + 1
    
21. '                            brr(m, -1) = m
    
22.                             For j = 0 To UBound(arr)
    
23.                                 brr(m, j) = arr(j, i)
    
24.                             Next
    
25.                         Next
    
26.                     End If
    
27.                 End If
    
28.                 rs.MoveNext
    
29.             Loop
    
30.         End If
    
31.         MyName = Dir()
    
32.     Loop
    
33.     [a1].CurrentRegion.Offset(1).ClearContents
    
34.     [a2].Resize(m, 29) = brr
    
35. '    Cells(m + 3, 1) = "合计"
    
36. '    Cells(m + 3, 7).Resize(, 7).FormulaR1C1 = "=SUM(R3C:R" & m + 2 & "C)"
    
37.     cnn.Close
    
38.     Set cnn = Nothing
    
39.     Application.ScreenUpdating = True
    
40.     MsgBox Timer - tt
    
41. End Sub

复制代码

xbq

powerquery

abc123281

日报汇总123.rar (125.71 KB, 下载次数: 22)

2018-8-18 18:38 上传

点击文件名下载附件

tzx021305

谢谢大家，特别是abc123281,每天可以省半小时复制时间了