求如何把数据汇总到另一个表格

wzd028

打开月度采购计划汇总表，原来点击“各部门汇总数据”按钮，可以汇总有物品编号的数据（含图片），现在要增加把各部门使用计划表没有物品编号的物品（含图片）也要汇总到汇总表里面，但点击“各部门汇总数据”按钮不能汇总，求大师帮忙修改，谢谢！

   求助.7z (883.23 KB, 下载次数: 14)

2023-4-29 13:30 上传

点击文件名下载附件

zpy2

没有发现图片？

另外，是不是需要用在线表单收集比较方便。

wzd028

zpy2 发表于 2023-4-29 15:40
没有发现图片？

另外，是不是需要用在线表单收集比较方便。

谢谢老师百忙中的帮助：
1、上传的采购计划汇总表原来是可以汇总数据和图片，我现在在各部门使用计划表里面增加了没有物品编号的物品，有几个“各部门使用计划表”没有物品编号的物品有图片，在点击“各部门汇总数据”按钮时出现不能汇总。
2、另外你提出的“是不是需要用在线表单收集比较方便”，这些表格是通过微信发过来的，没办法操作。

zpy2

wzd028 发表于 2023-5-2 16:37
谢谢老师百忙中的帮助：
1、上传的采购计划汇总表原来是可以汇总数据和图片，我现在在各部门使用计划表 ...

https://club.excelhome.net/forum.php?mod=viewthread&tid=1659202&page=1&mobile=是不是需要多表合并，然后数据清洗，再数据透视？

ykcbf1100

汇总部分完成。

附件供参考。。。

ykcbf1100

代码如下：

1. Sub ykcbf()    '//2023.5.2
   
2.     Dim arr, brr, d, p, f
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Dim tm: tm = Timer
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     Set d1 = CreateObject("scripting.dictionary")
   
8.     b = [{2,3,4,5,6,12,10}]
   
9.     Set sh = ThisWorkbook.Sheets("采购计划表")
   
10.     p = ThisWorkbook.Path & ""                '//文件路径
    
11.     f = Dir(p & "*.xls*")                      '//文件名
    
12.     Do While f <> ""
    
13.         If f <> ThisWorkbook.Name Then
    
14.             fn = Split(Split(f, ".")(0), "（")(1)
    
15.             fn = Left(fn, Len(fn) - 1)
    
16.             With Workbooks.Open(p & f, 0)
    
17.                 arr = .Sheets(1).UsedRange
    
18.                 .Close False
    
19.             End With
    
20.             For i = 3 To UBound(arr)
    
21.                 s = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4)
    
22.                 If s <> Empty Then
    
23.                     If Not d.exists(s) Then
    
24.                         d(s) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 12))
    
25.                     End If
    
26.                     d1(s & "|" & fn) = d1(s & "|" & fn) + arr(i, 10)
    
27.                 End If
    
28.             Next
    
29.         End If
    
30.         f = Dir
    
31.     Loop
    
32.     On Error Resume Next
    
33.     ReDim brr(1 To d.Count, 1 To 7)
    
34.     For Each k In d.keys
    
35.         m = m + 1
    
36.         brr(m, 1) = m
    
37.         T = d(k)
    
38.         For x = 0 To d.Count - 1
    
39.             brr(m, x + 2) = T(x)
    
40.         Next
    
41.     Next
    
42.     With sh
    
43.         .UsedRange.Offset(3).ClearContents
    
44.         .[a4].Resize(m, 7) = brr
    
45.         .[a4].Resize(m, 14).Borders.LineStyle = 1
    
46.         arr = .UsedRange
    
47.         For i = 4 To UBound(arr)
    
48.             For j = 8 To 14
    
49.                 s = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(2, j)
    
50.                 If s <> Empty Then
    
51.                     If d1.exists(s) Then
    
52.                         arr(i, j) = d1(s)
    
53.                     End If
    
54.                 End If
    
55.             Next
    
56.         Next
    
57.         .UsedRange = arr
    
58.         ActiveWindow.DisplayZeros = False
    
59.     End With
    
60.     Application.ScreenUpdating = True
    
61.     MsgBox "运行完毕，共用时： " & Format(Timer - tm) & "秒！"
    
62. End Sub
    
63. 
    

复制代码

wzd028

ykcbf1100 发表于 2023-5-2 19:22
代码如下：

你好，老师，抱歉我没有说清楚，要求是按原来的宏的设置来增加没有物品编号的汇总，点击“各部门汇总数据”按钮汇总，见附图（这个是删除没有物品编号后汇总的数据，如果有图片的要导入到备注行）。
   

ykcbf1100

wzd028 发表于 2023-5-2 21:43
你好，老师，抱歉我没有说清楚，要求是按原来的宏的设置来增加没有物品编号的汇总，点击“各部门汇总数据 ...

你的代码我看不懂啊，只能自己写。
确实没完全明白你要什么，汇总的思路写出来，相信依你的水平，再加备注也不难了。

wzd028

ykcbf1100 发表于 2023-5-2 21:52
你的代码我看不懂啊，只能自己写。
确实没完全明白你要什么，汇总的思路写出来，相信依你的水平，再加备 ...

我对宏也是不很熟悉，这些宏大部分都是各位老师帮助写的，谢谢你的帮助！