求助 多文件提取数据

沧海—粟

一个文件夹下有几十个表格文件，格式一样，要求把所有文件里的数据提取按要求汇总到汇总表，请高手帮忙做一下，万分感谢

小花鹿

没时间写代码，帮你顶一下                                                                                             

沧海—粟

书到用时方恨少，函数公式还可以把别人的复制过来用，这个vba代码怎么也搞不懂，想套用别人的都不行

chxw68

沧海—粟 发表于 2018-9-18 21:11
书到用时方恨少，函数公式还可以把别人的复制过来用，这个vba代码怎么也搞不懂，想套用别人的都不行

看不懂汇总表和分表项目之间的对应关系。

沧海—粟

chxw68 发表于 2018-9-18 21:35
看不懂汇总表和分表项目之间的对应关系。

分表有出库和入库，入是购进，出是销售，购进和销售里面都有带票和无票，用是否区分，总表里上面表格部分要统计所有带票购进和销售的数量金额，后边的剩余进项、已开、未开统计所有客户已经开走的票和未开的票，下面表格部分是统计出库里面每个客户带票销售的数据，还有每个客户开走的票和未开的票

LMY123

沧海—粟 发表于 2018-9-18 22:06
分表有出库和入库，入是购进，出是销售，购进和销售里面都有带票和无票，用是否区分，总表里上面表格部分 ...

Sub ADO加数组_汽油_购进_带票_汇总()
    tt = Timer
    [B3:Z1048576] = ""
    Dim cnn As Object, SQL$, Mypath$, MyName$, arr, brr(1 To 4, 1 To 10), i&, j&, m&
    Application.ScreenUpdating = False
    Mypath = ThisWorkbook.Path & "\"
    MyName = Dir(Mypath & "*.xlsx")
    Do While MyName <> ""
        If InStr(MyName, ThisWorkbook.Name) = 0 Then
            Set cnn = CreateObject("ADODB.Connection")
            cnn.Open "Provider=Microsoft.ACE.Oledb.12.0;Extended Properties='Excel 12.0;hdr=NO';Data Source=" & Mypath & MyName
            Set rs = cnn.OpenSchema(20)
            Do Until rs.EOF
                If rs.Fields("TABLE_TYPE") = "TABLE" Then
                    s = Replace(rs("TABLE_NAME").Value, "'", "")
                    If Right(s, 1) = "$" Then
                        If InStr(s, "入") Then
                            SQL = "select * from [" & s & "] "
                            arr = cnn.Execute(SQL).GetRows
                            For i = 0 To UBound(arr, 2)
                            If InStr(arr(1, i), "汽") And arr(5, i) = "是" Then
                                For j = 4 To 4
                                    brr(1, j - 3) = brr(1, j - 3) + arr(j, i)
                                Next
                            End If
                            Next
                        End If
                    End If
                End If
                rs.MoveNext
            Loop
        End If
        MyName = Dir()
    Loop
    [B3].Resize(1, 1) = brr
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
    MsgBox "用时" & Format(Timer - tt, "0.00") & "秒", 64, "提示"
End Sub

沧海—粟

LMY123 发表于 2018-9-19 11:06
Sub ADO加数组_汽油_购进_带票_汇总()
    tt = Timer
     = ""

LMY123老师，谢谢你的解答，但我不知道是不是我的问题，我把代码复制过去只能得到一个汽油结果购进的金额结果，其他的没有，我也想尝试用你得到代码改一下，不管怎样也只能得到一个品种的一个结果

沧海—粟

求求助助自 己顶一下，