复杂的多工作簿指定区域有数据的分表才逐一添加数据到汇总文件指定位置

peter-chen · 发表于 2023-5-16 21:05

本帖最后由 peter-chen 于 2023-5-18 21:18 编辑

请教各位大师及大神们，请帮我用VBA程序解决一个难题，就是要首先判断表格特定区域是否符合条件，符合的才把所有数据追加到合计表的指定区域，而且要包含合计文件所在的文件夹内的所有子文件夹！谢谢！
某个文件夹下有多个相同表格的文件，包括XLS或XLSA等不同excel版本的工作薄，需要写一个有VBA代码的EXCEL的合计文件，让这个合计文件去统计该文件夹下（包括子文件夹）的所有EXCEL工作薄文件中的所有表中的A4:D15和G4:I15到合计文件中的19行后的指定列中去，其中有时会有人误操作建立新表，但是新表中A4:I15没有数据的不纳入统计拷贝数据！

其中：对应工作薄名+工作表名显示在对应19行后的非空O列内（提高难度就是生成链接可以直接打开文件），A4：A15添加到对应19行后的B列内（注意A4和B4为合并单元格），C4:C15添加到对应19行后的K列内，D4:D15添加到对应19行后的L列内，G4：G15添加到对应19行后的B列内，H4:H15添加到对应19行后的K列内，I4:I15添加到对应19行后的L列内，把合计文件所在的文件夹内所有EXCEL文件（自身除外）的表中所有A4:D15和G4:I15数据逐一追加到合计文件中19行后指定的单元格内，每次执行这个统计汇总宏代码前，都把A20：o68856内数据先清空。M,N列加通过计算得出的数值。其他数据不处理。不指定文件所在路径，不管文件在哪，只要是合计文件所有的文件夹就执行该合计文件所在路径下的所有EXCEL文件的以上数据追加汇总。

具体分表见附件，预计出来的结果看总表（合计.xlsm），谢谢各位老师的指导。

补充内容 (2023-5-20 10:23):
新附件见21楼，谢谢，O列除了显示文件名和表名，还自动生成链接，方便有问题可以直接打开查看

吴中泉 · 发表于 2023-5-16 21:21

需求写的很详细，类似的要求往贴也很多，我把前天写的类似代码发给你参考

Sub 汇总()
Application.ScreenUpdating = False
lj = ThisWorkbook.Path & ""
With Sheets("汇总表")
.Rows("6:200000").Clear
f = Dir(lj & "*.xls*")
Do While f <> ""
      If f <> ThisWorkbook.Name Then
         Set wb = Workbooks.Open(lj & f, 0)
         Set sht = wb.Worksheets(1)
         r = sht.Cells(Rows.Count, 2).End(xlUp).Row
         If r >= 5 Then
            rs = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            If rs < 6 Then rs = 6
            sht.Rows("6:" & r).Copy .Cells(rs, 1)
         End If
         wb.Close False
      End If
f = Dir
Loop
End With
分类排序
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
Sub 分类排序()
Sheets("汇总表").Rows.Copy Sheets("按行业汇总").[a1]
With Sheets("按行业汇总")
r = .Cells(Rows.Count, 2).End(xlUp).Row
.Rows("6:" & r).Sort [D5], Header:=xlNo
End With
Sheets("汇总表").Rows.Copy Sheets("按产值汇总").[a1]
With Sheets("按产值汇总")
r = .Cells(Rows.Count, 2).End(xlUp).Row
.Rows("6:" & r).Sort [e5], Header:=xlNo
End With
Sheets("汇总表").Rows.Copy Sheets("按增长率").[a1]
With Sheets("按增长率")
r = .Cells(Rows.Count, 2).End(xlUp).Row
.Rows("6:" & r).Sort [g5], Header:=xlNo
End With
End Sub