统计出库返库的差额，不知道程序哪里出错，请教

fifi0703

因为产品要发外加工，想统计下出库和返库的差额。

产品分整件的和散件称重的

一共四张表格，期初列了所有的产品信息，一张出库表，一张返库表，最后一张统计表
因为外加工种类繁多，所以设定必须单位名称、类别、品名、出库及返库的颜色都完全匹配才能归类统计差额，
按重量的散件都可以被统计到，
但是整件的出库数据就无法被统计到：


不知道哪里出了问题，请高手们帮忙看看，谢谢！

差额.zip (493.57 KB, 下载次数: 6)

2024-4-26 10:47 上传

点击文件名下载附件

chxw68

把工作簿保护密码取消了重新上传一份附件。

fifi0703

chxw68 发表于 2024-4-26 10:46
把工作簿保护密码取消了重新上传一份附件。

刚刚也发现这个问题了，已经重新上传了

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Dim ws As Worksheet
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With Worksheets("期初")
   
8.         .AutoFilterMode = False
   
9.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.         arr = .Range("a2:i" & r)
    
11.     End With
    
12.     ReDim brr(1 To UBound(arr), 1 To 14)
    
13.     For i = 1 To UBound(arr)
    
14.         brr(i, 1) = arr(i, 1)
    
15.         brr(i, 2) = arr(i, 2)
    
16.         brr(i, 3) = arr(i, 3)
    
17.         brr(i, 4) = arr(i, 4)
    
18.         brr(i, 5) = arr(i, 5)
    
19.         brr(i, 6) = arr(i, 6)
    
20.         brr(i, 10) = arr(i, 7)
    
21.         brr(i, 11) = arr(i, 8)
    
22.         xm = brr(i, 1) & "+" & brr(i, 2) & "+" & brr(i, 3) & "+" & brr(i, 4) & "+" & brr(i, 5)
    
23.         d(xm) = i
    
24.     Next
    
25.     For Each ws In Worksheets(Array("出库明细", "外加工返库明细"))
    
26.         With ws
    
27.             .AutoFilterMode = False
    
28.             r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
29.             arr = .Range("a2:m" & r)
    
30.             For i = 1 To UBound(arr)
    
31.                 xm = arr(i, 3) & "+" & arr(i, 4) & "+" & arr(i, 5) & "+" & arr(i, 6) & "+" & arr(i, 7)
    
32.                 If d.exists(xm) Then
    
33.                     m = d(xm)
    
34.                     If ws.Name = "出库明细" Then
    
35.                         brr(m, 7) = brr(m, 7) + arr(i, 8)
    
36.                         brr(m, 12) = brr(m, 12) + arr(i, 10)
    
37.                     Else
    
38.                         brr(m, 8) = brr(m, 8) + arr(i, 8)
    
39.                         brr(m, 13) = brr(m, 13) + arr(i, 10)
    
40.                     End If
    
41.                 End If
    
42.             Next
    
43.         End With
    
44.     Next
    
45.     For i = 1 To UBound(brr)
    
46.         brr(i, 9) = brr(i, 6) + brr(i, 7) - brr(i, 8)
    
47.         brr(i, 14) = brr(i, 11) + brr(i, 12) - brr(i, 13)
    
48.     Next
    
49.     With Worksheets("出入库情况汇总")
    
50.         .UsedRange.Offset(1, 0).Clear
    
51.         .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
52.     End With
    
53. End Sub
    

复制代码

chxw68

重新写了一段供楼主参考。

fifi0703

chxw68 发表于 2024-4-26 11:18
重新写了一段供楼主参考。

可以了，出库明细被可能被覆盖了，所以汇总表里出错了，我把程序放回我原上传的文件里面就可以了

fifi0703

chxw68 发表于 2024-4-26 11:18
重新写了一段供楼主参考。

万分感谢，真的可以了。原来的程序是哪里错了吗？

chxw68

把楼主的代码也修改好了，错误出在前面数组取值范围错了，这个问题非常隐蔽。

chxw68

红框内的工作表名刚好颠倒了。

fifi0703

chxw68 发表于 2024-4-26 11:43
红框内的工作表名刚好颠倒了。

您真是太棒了