如何用VBA汇总同一文件下多个工作薄

adm0795

如附件,我要把每个月每天的生产明细汇总一个总表上.表最后两栏,要把当天及各班次写上

重新上传了附件，请大侠帮帮忙!

fanyoulin

1、这种代码被人写烂了，几十上百次肯定是有的。百度上找一个类似的，自己再修改下；
2、你这也没有具体的文件和数据，仅凭一张图片，肯定是写不了的。真要重写代码难度还是有一些的，子目录的检索不是那么好弄，要递归或双循环，所以还是去百度上找一个省事。本论坛应该也有，没有百度检索方便；

我估计有那么多时间给你写代码的人不好找，简单问题很好找人解决，你这个会很花时间。

约定的童话

具体文件穿上来啊，你弄个截个图咋汇总

adm0795

约定的童话 发表于 2019-10-23 14:46
具体文件穿上来啊，你弄个截个图咋汇总

不好意思，重新上传了附件。因每天都有新增表，要求把每个月每天的表汇总到一个总表上

opiona

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

约定的童话

adm0795 发表于 2019-10-23 15:23
不好意思，重新上传了附件。因每天都有新增表，要求把每个月每天的表汇总到一个总表上

让其他大神看下吧，我这会没空了...

xiangbaoan

………………

adm0795

xiangbaoan 发表于 2019-10-23 19:18
………………

为何在实际运用中：出现错误提示：在联合查询中所选定的两个数据表或查询中的列数不匹配

xiangbaoan

adm0795 发表于 2019-10-23 20:11
为何在实际运用中：出现错误提示：在联合查询中所选定的两个数据表或查询中的列数不匹配

代码中有注释。猜测，实际的数据表中还有深度隐藏的工作表。

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Set sh = ActiveSheet
    sh.UsedRange.Offset(1).ClearContents
    For Each f In CreateObject("scripting.filesystemobject").getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, "汇总表") = 0 Then
            With Workbooks.Open(f)
                For Each sht In .Sheets
                    If sht.Visible = True Then
                        r = sht.Cells(Rows.Count, 1).End(3).Row
                        arr = Application.Intersect(sht.Rows("3:" & r), sht.UsedRange)
                        r = sh.Cells(Rows.Count, 1).End(3).Offset(1).Row
                        sh.Cells(r, 1).Resize(UBound(arr) - 1, UBound(arr, 2)) = arr
                        sh.Cells(r, "u").Resize(UBound(arr) - 1).Value = Split(f.Name, ".")(0)
                        sh.Cells(r, "v").Resize(UBound(arr) - 1).Value = Left(sht.Name, 1)
                    End If
                Next sht
                .Close False
            End With
        End If
    Next f
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub