求租提取所有文件夹中同一列数据生成一张汇总报表

dagal

附件中有一汇总表，能否用VBA的方式将所有文件夹下的工作簿中汇总工作表的C列数据提取到汇总表中，并在最后一列生成总额 17年6月份报表.rar (499.63 KB, 下载次数: 20)

2018-7-13 09:59 上传

点击文件名下载附件

LMY123

多夹多薄指定表合并或汇总成一薄一表

dagal

LMY123 发表于 2018-7-13 10:05
多夹多薄指定表合并或汇总成一薄一表

是的，能帮忙解下么

LMY123

dagal 发表于 2018-7-13 10:06
是的，能帮忙解下么

http://club.excelhome.net/thread-1409141-1-1.html

魂断蓝桥

Option Explicit
Dim arr(1 To 50, 1 To 2), i As Integer
Sub Test()
Dim cnn, sql$, j%, n%, wjm$, BRR, CRR
Set cnn = CreateObject("ADODB.CONNECTION")
i = 0
Sea ThisWorkbook.Path & "\"
    For j = 1 To i
     If arr(i, 2) <> 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=" & arr(i, 1)
           sql = "SELECT F1,F3 FROM [汇总$a5:c65] "
        Else
           sql = sql & " UNION ALL SELECT F1,F3 FROM [Excel 8.0;Database=" & arr(i, 1) & "].[汇总$a5:c65]  "
        End If
     End If
Next
    sql = "SELECT F1,SUM(F3) FROM (" & sql & ") GROUP BY F1"
BRR = cnn.Execute(sql).GETROWS
Set cnn = Nothing
CRR = [A5:A65]
For i = 1 To UBound(CRR)
    For j = 0 To UBound(BRR, 2)
        If CRR(i, 1) = BRR(0, j) Then
            If CRR(i, 1) = "4" Then
                CRR(i, 1) = BRR(1, j) / n
            Else
                CRR(i, 1) = BRR(1, j)
            End If
            Exit For
        End If
    Next
Next
[E5].Resize(UBound(CRR), 1) = CRR
End Sub

    Sub Sea(P)
    Dim f As Object
    For Each f In CreateObject("scripting.FileSystemObject").GetFolder(P).Files
      If f.Name Like "*.xls*" And f.Name <> ThisWorkbook.Name And Left(f.Name, 1) <> "~" Then
        i = i + 1
        arr(i, 1) = f.Path '& f.Name
        arr(i, 2) = f.Name '& f.Name
      End If
    Next
    For Each f In CreateObject("scripting.FileSystemObject").GetFolder(P).SubFolders
      Sea f
    Next
    End Sub

jjmysjg

魂断蓝桥 发表于 2018-7-13 10:47
Option Explicit
Dim arr(1 To 50, 1 To 2), i As Integer
Sub Test()

大侠好！
能写个非SQL的代码吗
谢谢

dagal

调试的时候提示：运行错误，数据库引擎找不到对象：汇总$a5:c65，是啥原因呀

dagal

魂断蓝桥 发表于 2018-7-13 10:47
Option Explicit
Dim arr(1 To 50, 1 To 2), i As Integer
Sub Test()

调试的时候提示：运行错误，数据库引擎找不到对象：汇总$a5:c65，是啥原因呀。另外以后场所多了，各场所的表会不断增加，能否在第四行的每一列自动提取场所代码，就是文件名B表前面1706-后面的字母和数字，如JZ03,JZ05,JZ06,JZ07等。

魂断蓝桥

dagal 发表于 2018-7-13 11:17
调试的时候提示：运行错误，数据库引擎找不到对象：汇总$a5:c65，是啥原因呀。另外以后场所多了，各场所 ...

以你的附加测试没有问题。
第四行的每一列自动提取场所代码 ，没看懂，你这个是合计的数值（一个值是16个文件汇总得来的。），如何列出场所？

dagal

魂断蓝桥 发表于 2018-7-13 14:52
以你的附加测试没有问题。
第四行的每一列自动提取场所代码 ，没看懂，你这个是合计的数值（一个值是16 ...

我的意思是这一行做为场所的代码，目前是16个文件，以后如果多了，是否支持向右扩容。这个代码就以文件名中的代码写到这一行里，这样才知道哪一列是哪个场所的