关于合并各分库库存的问题

owennoyes · 发表于 2018-7-26 10:11

合并库存.rar (17.2 KB, 下载次数: 13)

详见附件，内有详细说明。
简要说明如下：
各分库的库存为已知数，需要生成的页面在最后一页，材料列能自动生成且不能有遗漏，因实际数据量很大，希望通过VBA或尽量简单的公式实现功能，谢谢各位老师！

owennoyes · 发表于 2018-7-26 16:40

帖子沉得好快，顶起来

不知道为什么 · 发表于 2018-7-26 17:06

owennoyes 发表于 2018-7-26 16:40
帖子沉得好快，顶起来

如图

不知道为什么 · 发表于 2018-7-26 17:08

owennoyes 发表于 2018-7-26 16:40
帖子沉得好快，顶起来

代码

owennoyes · 发表于 2018-7-27 13:45

不知道为什么发表于 2018-7-26 17:08
代码

您好，我是vba小白，只会用不会编辑，您能把编辑好的文件发给我一下吗？
zkj1984022@163.com
谢谢您！

owennoyes · 发表于 2018-7-27 13:46

不知道为什么发表于 2018-7-26 17:08
代码

您好，我是vba小白，只会用不会编辑，您能把编辑好的文件发给我一下吗？
zkj1984022@163邮箱
谢谢您！

不知道为什么 · 发表于 2018-7-27 14:40

owennoyes 发表于 2018-7-27 13:46
您好，我是vba小白，只会用不会编辑，您能把编辑好的文件发给我一下吗？
zkj1984022@163邮箱
谢谢您！

附件送上，供参考

合并库存-R.zip (17.65 KB, 下载次数: 11)

魂断蓝桥 · 发表于 2018-7-27 14:59

Sub a()
Dim arr, brr, d1, d2, i, j, sh As Worksheet, mysum%
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For Each sh In Sheets
If sh.Name <> "合并库存" Then
      arr = sh.[a1].CurrentRegion
         For i = 2 To UBound(arr)
            d1(arr(i, 1)) = ""
            d2(arr(i, 1) & sh.Name) = d2(arr(i, 1) & sh.Name) + arr(i, 2)
         Next
End If
Next
[a5:m9999] = ""
[a5].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
arr = [a4].CurrentRegion
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
      arr(i, j) = d2(arr(i, 1) & arr(1, j))
      mysum = mysum + arr(i, j)
Next
      arr(i, 14) = mysum
      mysum = 0
Next
[a4].Resize(UBound(arr), UBound(arr, 2)) = arr
Set d1 = Nothing
Set d2 = Nothing
End Sub

owennoyes · 发表于 2018-7-28 15:51

不知道为什么发表于 2018-7-27 14:40
附件送上，供参考

合并库存（VBA版）.rar (72.92 KB, 下载次数: 4)

老师你好，实际应用时出现新的问题，显示运行时错误9：下标越界

您再给调试一下吧，谢谢！

不知道为什么 · 发表于 2018-7-28 16:26

owennoyes 发表于 2018-7-28 15:51
老师你好，实际应用时出现新的问题，显示运行时错误9：下标越界

您再给调试一下吧，谢谢！

如图，需要把 brr 定义数量大些

TIM截图20180728162449.jpg

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

[求助] 关于合并各分库库存的问题

评分

评分