多个工作表的数据自动汇总到 汇总 表格内

夜上海

食堂每天接到发来的配送清单，每天复制黏贴非常麻烦，现在希望能够多个工作表的数据自动汇总到 汇总 表格内，每个工作表的行名称一致，但后面多个工作表的数据行都从第五行开始，现在需要将每天的记录汇总罗列在一起，但不需要汇总计算，以一个工作表中有多少条记录，就对应有多少个 此工作表的名称

wdy895

可以使用pq加载查询.但是如果你后期还要增加sheet表且格式和前面的sheet一样，主要有两个问题。1、数据后面的空行已经填充了边框，pq就会把它一起汇总，但里面没数据。2.填充了边框的空单元格后面还有数据（例如某某制单），汇总了没有用，但是汇总会加载进来。

ykcbf1100

分表有好几个坑，需要避开，一是数据列不同，二是数据区有大量空行。

wdy895

wdy895 发表于 2022-11-17 16:08
可以使用pq加载查询.但是如果你后期还要增加sheet表且格式和前面的sheet一样，主要有两个问题。1、数据后 ...

你看一下现在这种汇总是否满足你的需求？你可以任意增加和删除sheet表。可以删除sheet里的数据，但是不能增加列字段。增加或者删除后按保存，之后在汇总里右键刷新。数据就同步加载。

ykcbf1100

wdy895 发表于 2022-11-17 16:16
你看一下现在这种汇总是否满足你的需求？你可以任意增加和删除sheet表。可以删除sheet里的数据，但是不能 ...

你这个序号和空行都提取过来了，应该不符合题意。

洋务德雷

这个编辑vba就可以了。

fzxba

1. Sub test()
   
2.   Dim Conn As Object, rs As Object, Sht As Worksheet
   
3.   Dim ar() As String, i As Long, r As Long
   
4.   Set Conn = CreateObject("ADODB.Connection")
   
5.   If Application.Version < 12 Then
   
6.     Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
   
7.   Else
   
8.     Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
   
9.   End If
   
10.   For Each Sht In Worksheets
    
11.     With Sht
    
12.       If .Name <> "汇总" Then
    
13.         If Len(.Range("A1").Value) Then
    
14.           r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.           If r > 4 Then
    
16.             i = i + 1
    
17.             ReDim Preserve ar(1 To i)
    
18.             ar(i) = "SELECT '" & .Name & "' AS 工作表名,商品名称,申购数量,单位,单价,采购数量,实收,合计,备注 FROM [" & .Name & "$A4:I" & r & "] WHERE LEN(TRIM(商品名称))"
    
19.           End If
    
20.         End If
    
21.       End If
    
22.     End With
    
23.   Next
    
24.   Set rs = Conn.Execute(Join(ar, " UNION ALL "))
    
25.   With Worksheets("汇总")
    
26.     .Range("A1").CurrentRegion.Offset(1).ClearContents
    
27.     For i = 0 To rs.Fields.Count - 1
    
28.       .Range("A1").Offset(0, i) = rs.Fields(i).Name
    
29.     Next
    
30.     .Range("A2").CopyFromRecordset rs
    
31.   End With
    
32.   Set rs = Nothing
    
33.   Conn.Close
    
34.   Set Conn = Nothing
    
35.   Beep
    
36. End Sub

复制代码

夜上海

非常感谢fzxba   

XL3750727

各位大神，能不能帮我解决一下这个问题，就是想把每个表里面的材料放在材料清单里面，玻璃的数据放在玻璃清单里面，不用汇总，只是记录进去就行了。谢谢大家了。

XL3750727

ykcbf1100 发表于 2022-11-17 16:12
分表有好几个坑，需要避开，一是数据列不同，二是数据区有大量空行。

草爷，帮我看看这个贴子里在那个附件，谢谢您了。