请问如何读取其他目录下所有EXCEL文件里的数据

ggyyzyf

请问如何读取其他目录下所有EXCEL文件里的数据

ggyyzyf

请见附件表格，谢谢！

dyp1610

请发到vba版块，实际上这个问题你搜搜就知道了
如：
mypath="c:\www"
myfile=dir("\" & mypath & \*.xls " )
do while myfile<>"" then
……
myfile=dir
loop
……

zhaogang1960

请参考：

1. Sub Macro1()
   
2.     Dim cnn As Object, SQL$, p$, f$, m&, arr, brr(), i&, j&, r, c, dr As Object, dc As Object
   
3.     Set dr = CreateObject("scripting.dictionary")
   
4.     Set dc = CreateObject("scripting.dictionary")
   
5.     arr = [a1].CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         dr(arr(i, 1) & ".xlsx") = i
   
8.     Next
   
9.     For j = 2 To UBound(arr, 2)
   
10.         dc(arr(1, j)) = j
    
11.     Next
    
12.     ReDim brr(2 To i - 1, 2 To j - 1)
    
13.     p = ThisWorkbook.Path & "\test"
    
14.     f = Dir(p & "*.xlsx")
    
15.     Do While f <> ""
    
16.         m = m + 1
    
17.         If m = 1 Then
    
18.             Set cnn = CreateObject("adodb.connection")
    
19.             cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=excel 12.0;Data Source=" & p & f
    
20.             SQL = "select 货物,金额 from [" & Replace(f, ".xlsx", "$]")
    
21.         Else
    
22.             SQL = "select 货物,金额 from [Excel 12.0;Database=" & p & f & ";].[" & Replace(f, ".xlsx", "$]")
    
23.         End If
    
24.         arr = cnn.Execute(SQL).GetRows
    
25.         r = dr(f)
    
26.         If r <> "" Then
    
27.             For i = 0 To UBound(arr, 2)
    
28.                 c = dc(arr(0, i))
    
29.                 If c <> "" Then brr(r, c) = arr(1, i)
    
30.             Next
    
31.         End If
    
32.         f = Dir()
    
33.     Loop
    
34.     [a1].CurrentRegion.Offset(1, 1).ClearContents
    
35.     [b2].Resize(UBound(brr) - 1, UBound(brr, 2) - 1) = brr
    
36.     cnn.Close
    
37.     Set cnn = Nothing
    
38. End Sub
    
39. 
    
40. 
    

复制代码

zhaogang1960

请测试附件
test.rar (41.29 KB, 下载次数: 23)

2014-5-1 21:52 上传

点击文件名下载附件

ggyyzyf

谢谢5楼，很棒

LMY123

c = dc(arr(0, i))