[已解决]求助跨表多列条件求和汇总并标记VBA代码

hnyxq · 发表于 2016-4-21 09:05

本帖最后由 hnyxq 于 2016-4-21 13:00 编辑

汇总表要求把所有的工作单名称、单位、计算式、总量4列汇总，并且标明所有名称的工作单号。工作名称不能重复。实际工作有很多张，不止3张，手动累加太麻烦而且易错，想做一个VBA，无奈数组和字典至今没学懂。求各位老师帮忙解决，谢谢！

图片

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-22 11:29

这样吗？

跳转到最佳答案楼层

grf1973 · 发表于 2016-4-22 11:29

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

这样吗？

grf1973 · 发表于 2016-4-21 10:35

Sub 汇总()
dh = "①②③④⑤⑥⑦⑧⑨⑩⑾⑿⒀⒁⒂⒃⒄⒅⒆⒇" '单号，如有增加请自行添加
Dim sh As Worksheet
Set d = CreateObject("scripting.dictionary")
Dim brr(1 To 100, 1 To 6)
For k = 2 To Sheets.Count
Set sh = Sheets(k)
r = sh.[c65536].End(3).Row
xdh = Mid(dh, k - 1, 1)
If r >= 13 Then
arr = sh.Range("c13:f" & r)
For i = 1 To UBound(arr)
x = arr(i, 1)
If Not d.exists(x) Then
n = n + 1: d(x) = n
brr(n, 1) = n
For j = 2 To 5: brr(n, j) = arr(i, j - 1): Next
brr(n, 6) = xdh
Else
p = d(x)
brr(p, 4) = brr(p, 4) & "+" & arr(i, 3)
brr(p, 5) = brr(p, 5) + arr(i, 4)
If InStr(brr(p, 6), xdh) = 0 Then brr(p, 6) = brr(p, 6) & xdh
End If
Next
End If
Next
If n > 0 Then [a10].Resize(n, 6) = brr
End Sub

复制代码

hnyxq · 发表于 2016-4-21 18:01

grf1973 发表于 2016-4-21 10:35

非常感谢grf1973老师的快速解答，收益匪浅，虽然看不懂你的代码，不过测试非常成功，向你致敬。冒昧的问一下，能不能再提点要求？可能是我的工作单示例写得太简单的缘故，如果每项工作的计算式很长，各张工作单相同项目累加计算式会变得很长很长，即占用单元格又不美观，也没必要，审核起来很多余。能不能在汇总表的计算式中列出各张工作单每项工作结果的计算式？再次感谢！

关闭
上传图片
普通上传
相册图片
网络图片

请输入图片地址	宽(可选)	高(可选)

提交

上传 ←选择完文件后请点击“上传”按钮

上传中，请稍候，您可以暂时关闭这个小窗口，上传完成后您会收到通知
文件尺寸: 小于 500KB , 可用扩展名: jpg, jpeg, gif, png

确定


	关闭上传图片普通上传相册图片网络图片

hnyxq · 发表于 2016-4-22 11:40

hnyxq 发表于 2016-4-21 18:01
非常感谢grf1973老师的快速解答，收益匪浅，虽然看不懂你的代码，不过测试非常成功，向你致敬。冒昧的问一 ...

感谢grf1973老师的源程序，请问各位老师能不能再修改一下程序，达到完美程度。谢谢！

工作单汇总源程序.rar (13.48 KB, 下载次数: 5)

hnyxq · 发表于 2016-4-22 11:44

grf1973 发表于 2016-4-22 11:29
这样吗？

就是这样，这么快就解决了。最佳答案，完美答案。感谢老师。

hnyxq · 发表于 2016-4-22 11:53

grf1973 发表于 2016-4-22 11:29
这样吗？

感谢老师的最佳答案。我想设置为最佳答案，不知道在哪里设置，我是新手请以后多关照，谢谢。

lxlyhu · 发表于 2016-4-22 22:08

E:\lxlyhu\我的自动备份文件夹\products\mergebooks安装程序\跨表查询1.png
E:\lxlyhu\我的自动备份文件夹\products\mergebooks安装程序\跨表查询2.png

lxlyhu · 发表于 2016-4-22 22:09

E:\lxlyhu\我的自动备份文件夹\products\mergebooks安装程序\跨表查询1.png

lxlyhu · 发表于 2016-4-22 22:09

插入不了图片

		自动登录	找回密码
密码			注册

[已解决]求助跨表多列条件求和汇总并标记VBA代码

评分