提取同一文件夹中不同工作簿名并提取数据

neke@520

经常客串帮人做标书，提取同一文件夹中不同工作簿名并提取数据该怎么改代码？
论坛赵老师已经有类似的，但是还不是我想要的结果。因为要删除近1000个子表，能优化速度吗？
具体看附件，如果增加的希望有注释也学习下，谢谢各位

zhaogang1960

请参考：
Sub Macro1()
    Dim cnn As Object, SQL$, p$, f$, n&, t$, arr(1 To 65535, 1 To 2)
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Offset(1).ClearContents
    Set cnn = CreateObject("ADODB.Connection")
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            n = n + 1
            If n = 1 Then
                cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no';Data Source=" & p & f
            Else
                t = "[Excel 8.0;hdr=no;Database=" & p & f & "]."
            End If
            SQL = "select * from " & t & "[汇总表一$b:g] where f1='合计'"
            arr(n, 1) = Replace(f, ".xls", "")
            arr(n, 2) = cnn.Execute(SQL)(5)
        End If
        f = Dir()
    Loop
    Range("a2").Resize(n, 2) = arr
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
End Sub

百旺表格

蓝桥大师 水平高。

我是新手，有个类似的 表。也需要帮忙。可是，新手权限不够啊。这里多攒积分吧

neke@520

zhaogang1960 发表于 2017-2-20 19:43
请参考：
Sub Macro1()
    Dim cnn As Object, SQL$, p$, f$, n&, t$, arr(1 To 65535, 1 To 2)

老师，复制这个代码运行后出错了，是什么问题呢?是因为我改了子表名称l的原因吗？

zhaogang1960

neke@520 发表于 2017-2-22 00:02
老师，复制这个代码运行后出错了，是什么问题呢?是因为我改了子表名称l的原因吗？

如果所有数据表名都一致，不会出现该错误

neke@520

zhaogang1960 发表于 2017-2-22 11:53
如果所有数据表名都一致，不会出现该错误

版主，能提取工作簿名称，但是提取不了B列“合计”所在行对应的G列单元格数据。如合计在B13，应还提取G13数据。附件已上传

neke@520

百旺表格 发表于 2017-2-21 21:36
蓝桥大师 水平高。

我是新手，有个类似的 表。也需要帮忙。可是，新手权限不够啊。这里多攒积分吧

多关注本论坛，学习交流下会有很大收货
我以前有个中级号，现在登不了又重新注册的

zhaogang1960

neke@520 发表于 2017-2-22 16:43
版主，能提取工作簿名称，但是提取不了B列“合计”所在行对应的G列单元格数据。如合计在B13，应还提取G13 ...

合计中间有空格所致，从工作表中复制合计到SQL语句：

提数示例.rar (69.74 KB, 下载次数: 285)

2017-2-22 17:16 上传

点击文件名下载附件

百旺表格

各位水平太高了，我抓紧学习

neke@520

百旺表格 发表于 2017-2-22 20:46
各位水平太高了，我抓紧学习

我水平也不高，以前学习了论坛的书籍《EXCELVBA其实很简单》知道群里很多高手