多表格多sheet汇总数据（如图）拜托，不保留第一行。

Meゑゑ

表1：
表2：
如图中有很多表格表1、表2、表3.........
每个表格中都有多个sheet（但是格式内容都是相同的）
如果把表1、表2、表3.......放在同一个文件内，打开一个模版之后，如果把他们一次性汇总出来。
最终的结果:
其他表格以此类推。

ykcbf1100

搞啥呢，附件都不上传一个。

ykcbf1100

这活没附件整不了。

Meゑゑ

ykcbf1100 发表于 2024-3-4 19:53
这活没附件整不了。

已上传附件

shiruiqiang

3张表格有合并单元格，只能分开写法

ykcbf1100

你这个汇总表很奇怪，总是出现“汇总.xlsx”文件列表

fzxba

改-去掉附件中隐藏的文件它影响汇总结果.rar (97.18 KB, 下载次数: 20)

2024-3-5 06:51 上传

点击文件名下载附件

SQL参考

ykcbf1100

代码看上去没毛病，但汇总结果总是不正确。
你参考一下吧。

ykcbf1100

代码供参考。。。

1. Sub ykcbf()   '//2024.3.4
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Set ws = ThisWorkbook
   
7.     p = ThisWorkbook.Path & ""
   
8.     On Error Resume Next
   
9.     fn = "继续教育支出|住房贷款利息支出|赡养老人支出"
   
10.     For Each sht In ws.Sheets
    
11.         x = IIf(InStr(fn, sht.Name), 2, 1)
    
12.         d(sht.Name) = x
    
13.         sht.UsedRange.Offset(x).ClearContents
    
14.     Next
    
15.     For Each f In fso.GetFolder(p).Files
    
16.         If InStr(f, "汇总.xlsx") = 0 Then
    
17.             Set wb = Workbooks.Open(f, 0)
    
18.             For Each k In d.keys
    
19.                 Set sht = wb.Sheets(k)
    
20.                 With sht
    
21.                     r1 = sht.Find("*", , -4163, , 1, 2).Row
    
22.                     r = ws.Sheets(k).Find("*", , -4163, , 1, 2).Row
    
23.                     If r1 > d(k) Then .UsedRange.Offset(d(k)).Copy ws.Sheets(k).Cells(r + 1, 1)
    
24.                 End With
    
25.             Next
    
26.             wb.Close 0
    
27.         End If
    
28.     Next f
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "OK！"
    
31. End Sub
    

复制代码

Meゑゑ

fzxba 发表于 2024-3-4 21:13
SQL参考

好使，太牛了 神人