一个文件夹中多个文件汇总问题

gys_nmg

各位大神：一个文件夹中有多个文件要根据汇总表中的法人公司对照表把所对应的文件中工作表汇总在一起，就问有什么好的方法，法人公司对应的文件名不固定。，本人比较笨那位大神给弄一下，谢谢！

gys_nmg

来个大神帮下

iwangyi

未进行调试，楼主可自行调试
Sub 利润表汇总()
    Dim cnn As Object, cat As Object, d As Object
    Dim SQL$, MyFile$, arr(), i&, j&, t$, s$, wk$, m&, n&
    Application.ScreenUpdating = False
    MyPath = ThisWorkbook.Path & "\"
    MyFile = Dir(MyPath & "*.xlsx")
    Set cnn = CreateObject("adodb.connection")
    Set cat = CreateObject("ADOX.Catalog")
    Set d = CreateObject("scripting.dictionary")
    For yy = 5 To Sheets("利润表").Cells(3, 255).End(xlToLeft).Column Step 2
    For x = 4 To Sheets("法人公司对照表").[a65536].End(xlUp).Row
    If Cells(3, yy) = Sheets("法人公司对照表").Cells(x, 1) Then
    For y = 2 To Sheets("法人公司对照表").Cells(x, 255).End(xlToLeft).Column
    Do While MyFile <> ""
    If Sheets("法人公司对照表").Cells(x, y) = Split(MyFile, ".")(0) Then
        If MyFile <> ThisWorkbook.Name Then
            wk = Replace(MyFile, ".xlsx", "")
            n = n + 1
            If n = 1 Then cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & MyPath & MyFile
            cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & MyPath & MyFile
            For Each tb1 In cat.Tables
                If tb1.Type = "TABLE" Then
                    s = Replace(tb1.Name, "'", "")
                    If Right(s, 1) = "$" Then
                    If Left(s, Len(s) - 1) = "利润表" Then
                        SQL = "select 项  目,本期发生数金额,本年累计数金额 from [Excel 8.0;Database=" & MyPath & MyFile & "].[" & s & "a3:d65536]"
                        d(SQL) = ""
                    End If
                    End If
                End If
            Next
        End If
        MyFile = Dir()
    End If
    Loop
    Next y
    End If
    Next x
    If d.Count > 0 Then
    SQL = Join(d.Keys, " UNION ALL ")
    SQL = "select sum(本期发生数金额),sum(本年累计数金额) from (" & SQL & ") group by 项  目"
    Cells(5, yy).CopyFromRecordset cnn.Execute(SQL)
    d.RemoveAll
    End If
    Next yy
    Set cat = Nothing
    Set tb1 = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub

gys_nmg

iwangyi 发表于 2018-9-29 20:47
未进行调试，楼主可自行调试
Sub 利润表汇总()
    Dim cnn As Object, cat As Object, d As Object

对EXCEL函数还懂一点，看这个就等于天书，麻烦帮弄一下，谢谢！

gys_nmg

别沉，顶来起，来大神