文件夹下所有表格汇总

高家三少

求助各位大神，现在一个文件夹下有多个表格，我想将所有表格汇总在一个新的表格里，一列是每个表格的文件名，一列是对应表格的某个工作簿里的某个单元格的值。
如附件里的所示
多表格汇总.rar (32.53 KB, 下载次数: 48)

2013-4-28 15:03 上传

点击文件名下载附件
多表格汇总

zhaogang1960

汇总每个工作簿中的对账表的E2单元格？如果是请测试：

1. Sub 宏1()
   
2.     Dim cnn As Object
   
3.     Dim SQL$, MyFile$, Mypath$, n&, arr(1 To 10000, 1 To 2)
   
4.     Mypath = ThisWorkbook.Path & ""
   
5.     MyFile = Dir(Mypath & "*.xlsx")
   
6.     Do While MyFile <> ""
   
7.         n = n + 1
   
8.         If n = 1 Then
   
9.             Set cnn = CreateObject("ADODB.Connection")
   
10.             cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & Mypath & MyFile
    
11.             SQL = "select f1 from [对账$e2:e2]"
    
12.         Else
    
13.             SQL = "select f1 from [Excel 12.0;hdr=no;Database=" & Mypath & MyFile & "].[对账$e2:e2]"
    
14.         End If
    
15.         arr(n, 1) = Replace(MyFile, ".xlsx", "")
    
16.         arr(n, 2) = cnn.Execute(SQL)(0)
    
17.         MyFile = Dir()
    
18.     Loop
    
19.     [a1].CurrentRegion.Offset(1).ClearContents
    
20.     [a2].Resize(n, 2) = arr
    
21.     cnn.Close
    
22.     Set cnn = Nothing
    
23. End Sub
    

复制代码

zhaogang1960

请看附件
多表格汇总.rar (43.95 KB, 下载次数: 198)

2013-4-28 15:36 上传

点击文件名下载附件

dickywjl

我xlsx的文件打不开，不知道能不能如下修改呢：
Sub 宏1()
    Dim cnn As Object
    Dim SQL$, SQL2$, MyFile$, Mypath$
    Mypath = ThisWorkbook.Path & "\"
    MyFile = Dir(Mypath & "*.xlsx")
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & ThisWorkbook.FullName
    Do While MyFile <> ""
        If MyFile <> ThisWorkbook.Name Then
            SQL = "select '" & Replace(MyFile, ".xlsx", "") & "', f1 from [Excel 12.0;hdr=no;Database=" & Mypath & MyFile & "].[对账$e2:e2]"
            SQL2 = SQL2 & IIf(SQL2 = "", "", " union all ") & SQL
        End If
        MyFile = Dir()
    Loop
    Range("A1").CopyFromRecordset cnn.Execute(SQL2)
    cnn.Close: Set cnn = Nothing
End Sub

高家三少

zhaogang1960 发表于 2013-4-28 15:36
请看附件

感谢版主大大！！！测了可以，不过我想把e2换成h11 却提示超出电子数据单元范围

zhaogang1960

高家三少 发表于 2013-4-28 17:25
感谢版主大大！！！测了可以，不过我想把e2换成h11 却提示超出电子数据单元范围

1. Sub 宏1()
   
2.     Dim cnn As Object
   
3.     Dim SQL$, MyFile$, Mypath$, n&, arr(1 To 10000, 1 To 2)
   
4.     Mypath = ThisWorkbook.Path & ""
   
5.     MyFile = Dir(Mypath & "*.xlsx")
   
6.     Do While MyFile <> ""
   
7.         n = n + 1
   
8.         If n = 1 Then
   
9.             Set cnn = CreateObject("ADODB.Connection")
   
10.             cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & Mypath & MyFile
    
11.             SQL = "select f1 from [对账$e2:e2]"
    
12.         Else
    
13.             SQL = "select f1 from [Excel 12.0;hdr=no;Database=" & Mypath & MyFile & "].[对账$h11:h11]"
    
14.         End If
    
15.         arr(n, 1) = Replace(MyFile, ".xlsx", "")
    
16.         arr(n, 2) = cnn.Execute(SQL)(0)
    
17.         MyFile = Dir()
    
18.     Loop
    
19.     [a1].CurrentRegion.Offset(1).ClearContents
    
20.     [a2].Resize(n, 2) = arr
    
21.     cnn.Close
    
22.     Set cnn = Nothing
    
23. End Sub
    

复制代码

zhaogang1960

把原来E2的数值复制到H11上没有问题，请看附件
多表格汇总.rar (44.11 KB, 下载次数: 105)

2013-4-28 17:45 上传

点击文件名下载附件

高家三少

{:soso_e102:}可以了 非常感谢各位，特别鸣谢版主大大

LMY123

arr(n, 2) = cnn.Execute(SQL)(0)