如何多个格式一致文件汇总大量数据？

冬瓜啊

请帮忙写出VBA程序，在汇总表中，能直接把各文件的对应单元格数据，写入汇总表对应单元格位置。
现有情况：
1. wenjian1.xlsx等等有几千个文件，对应的单元格位置属性一样，数值不同。
2. 现有表格中的VLOOKUP函数有缺陷，数据量太大了，调用有问题。希望能改使用VB程序，直接调用各文件中对应位置的单元格数据，写到汇总表的对应位置。
3. 希望列A中文件名作为变量，能把对应的各文件位置I开始到GN写到汇总表的对应位置。
4.希望只要输入列A中文件名，后续的其他列单元格能自动调入各文件对应格的数据。
5.解压到：D:\例子\ 例子.rar (68.58 KB, 下载次数: 28)

2011-10-28 00:15 上传

点击文件名下载附件

zhaogang1960

第4个问题：
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Row < 8 Or Target.Column > 1 Then Exit Sub
    Dim cnn As Object, SQL$
    If Dir(ThisWorkbook.Path & "\" & Target.Value) <> "" Then
        Set cnn = CreateObject("ADODB.Connection")
        cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.Path & "\" & Target.Value
        SQL = "select * from [物料消耗$n7:gs7]"
        Target.Offset(, 8).CopyFromRecordset cnn.Execute(SQL)
        cnn.Close
        Set cnn = Nothing
    Else
        MsgBox ThisWorkbook.Path & "\" & Target.Value & "不存在，请检查！"
    End If
End Sub

zhaogang1960

一次性写完：
Sub 宏1()
    Dim cnn As Object, SQL$
    Dim arr, i&, MyFile$
    Mypath = ThisWorkbook.Path & "\"
    arr = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row)
    Set cnn = CreateObject("ADODB.Connection")
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Offset(7, 8).ClearContents
    For i = 8 To UBound(arr)
        If Dir(ThisWorkbook.Path & "\" & arr(i, 1)) <> "" Then
            m = m + 1
            If m = 1 Then cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & Mypath & arr(i, 1)
            SQL = "select * from [Excel 12.0;hdr=no;Database=" & Mypath & arr(i, 1) & "].[物料消耗$n7:gs7]"
            Cells(i, 9).CopyFromRecordset cnn.Execute(SQL)
        End If
    Next
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
End Sub

LMY123

SQL = "select * from [Excel 12.0;hdr=no;Database=" & Mypath & arr(i, 1) & "].[物料消耗$n7:gs7]"