工作簿汇总，工作表汇总合并，多文件汇总合并 通用代码 支持多层子文件夹

godmtv

非常实用的工具谢谢分享

xag889

太牛了，崇拜

hotdyj

强大的帖子

风灵之石

谢谢分享！！！

lidedong82

工作表工作簿合并取数

明月楼高可带刀

深秋的黎明 发表于 2020-1-27 17:27
既然是汇总表，应该有汇总合计的功能，还要增加一个表格模板和快捷链接吧

是的呀，想看下怎么按条件汇总计算

wawbt

不知如何收藏，先回复一下。

81490833

请问老师，修改了行数，提示
RS.Open StrSQL, CN, 1, 3 错误，有没有解决的额办法谢谢!

simon1324king

Sub Opiona()
   
    Rem 禁止系统刷屏?触发其他事件等
    'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
    Application.ScreenUpdating = False '//关闭屏幕刷新
    Application.DisplayAlerts = False '//关闭系统提示
    Application.EnableEvents = False  '//禁止触发其他事件
    Application.StatusBar = True   '关闭系统状态条
   
    T = Timer   '//开始时间
   
    Set SHX = Worksheets("汇总")
    firstrow = 3 '//汇总表标题所在行，下一行开始是数据
    I = firstrow + 1 '//数据记录的开始行，为什么不直接输入I=4？
    SHX.Range("A" & I & ":HZ1048576").ClearContents  '//清空数据区域
   
   
   
    Rem  获取各个分表清单
    For Each SH In Worksheets
        If SH.Name <> SHX.Name Then
            Rem  提示信息，在状态栏显示
            Application.StatusBar = " 当前提取的表格是：" & SH.Name
            DoEvents
            
            Rem 写入工作表名,写在汇总工作表第A列
            SHX.Cells(I, 1).Value = SH.Name
            'Debug.Print SHX.Cells(I, 1).Value
            Rem 找到需要的单元格位置
            For ICOL = 2 To SHX.Range("HZ" & firstrow).End(xlToLeft).Column  ''[IV1].End(xlToLeft).Column表示第一行末列向左第一列有数值之列数。icol=icolumn,此处与I值无关，前面已经是firstrow=3,I=firstrow+1=2
                Debug.Print "firstrow=" & firstrow
                Debug.Print "ICOL=" & ICOL
                If Len(SHX.Cells(firstrow - 1, ICOL).Value) > 0 Then '//如果汇总工作表第2行第ICOL列是非空单元格(字符长度大于零）
                   SHX.Cells(I, ICOL).Value = SH.Range(SHX.Cells(firstrow - 1, ICOL).Value).Value '复制数据到第i行，第ICOL列,SHX.Cells(firstrow - 1, ICOL)也就是SHX.Cells(2, ICOL)
                'Debug.Print SHX.Cells(I, ICOL).Value
                End If
            Next
            I = I + 1  '//准备记录下一条
        End If
    Next SH
   
    Application.StatusBar = False   '恢复系统状态条
    Application.EnableEvents = True  '//  '//恢复触发其他事件
    Application.ScreenUpdating = True '//恢复屏幕刷新
    Application.DisplayAlerts = True '//恢复系统提示
    MsgBox "一共用时：" & Format(Timer - T, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
   
End Sub

Du.

大佬 请教一下。4.单工作薄内多工作表。提示了报错 运行时错误3706，未找到提供程序。该程序可能未被安装。如何解决呢？