出入库数量及库存数量汇总

jordanlive

请高手帮忙写个VBA自动汇总统计代码

liulang0808

楼主在论坛里检索下吧，相关案例很多的

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。。

1. Sub ykcbf()  '//2024.4.15
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     For Each sht In Sheets
   
6.         If InStr(sht.Name, "明细") Then
   
7.             st = Left(sht.Name, 2)
   
8.             With sht
   
9.                 r = .Cells(Rows.Count, 1).End(3).Row
   
10.                 arr = .[a1].Resize(r, 8)
    
11.             End With
    
12.             For i = 3 To UBound(arr)
    
13.                 rq = Replace(arr(i, 8), ".", "/")
    
14.                 s1 = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6)
    
15.                 If Not d1.exists(s1) Then Set d1(s1) = CreateObject("Scripting.Dictionary")
    
16.                 d1(s1)(st) = d1(s1)(st) + arr(i, 7)
    
17.                 s = s1 & "|" & st & "|" & rq
    
18.                 d(s) = d(s) + arr(i, 7)
    
19.             Next
    
20.         End If
    
21.     Next
    
22.     ReDim Brr(1 To d1.Count, 1 To 10)
    
23.     For Each k In d1.keys
    
24.         m = m + 1
    
25.         b = Split(k, "|")
    
26.         Brr(m, 1) = m
    
27.         For x = 0 To UBound(b)
    
28.             Brr(m, x + 2) = b(x)
    
29.         Next
    
30.         For Each kk In d1(k).keys
    
31.             t = d1(k)(kk)
    
32.             If kk = "入库" Then Brr(m, 8) = t
    
33.             If kk = "出库" Then Brr(m, 9) = t
    
34.         Next
    
35.         Brr(m, 10) = Brr(m, 8) - Brr(m, 9)
    
36.     Next
    
37.     With Sheets("订单汇总表")
    
38.         .UsedRange.Offset(1) = ""
    
39.         .[a2].Resize(m, 10) = Brr
    
40.         c = .UsedRange.Columns.Count
    
41.         arr = .[a1].Resize(m + 1, c)
    
42.         For i = 2 To UBound(arr)
    
43.             For j = 11 To UBound(arr, 2)
    
44.                 s = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6) & "|" & "出库" & "|" & arr(1, j)
    
45.                 If d.exists(s) Then
    
46.                     arr(i, j) = d(s)
    
47.                 End If
    
48.             Next
    
49.         Next
    
50.         .[a1].Resize(m + 1, c) = arr
    
51.     End With
    
52.     Set d = Nothing
    
53.     Set d1 = Nothing
    
54.     Application.ScreenUpdating = True
    
55.     MsgBox "OK！"
    
56. End Sub
    
57. 
    

复制代码

清风竹-

  请看附件。

LIUZHU

表格设计得不是很规范，问题描述也有点含糊

牛牛神哦

因为我也有类似的工作场景，我是把出、入库都放在同一个表单里，然后数据透视得出结存，这样比较方便。
出入库记录，包含了库位、批次，只是目前我还没启用批次：




结存表单：

jordanlive

ykcbf1100 发表于 2024-4-15 08:41
参与一下。。。。

感谢老师，前半部分能实现了，现在还有个问题后面4月份中5日和10日出库的数量没有显示出来

ykcbf1100

jordanlive 发表于 2024-4-15 14:09
感谢老师，前半部分能实现了，现在还有个问题后面4月份中5日和10日出库的数量没有显示出来

有的啊，你没看啊。

jordanlive

ykcbf1100 发表于 2024-4-15 14:15
有的啊，你没看啊。

非常谢谢，有了，是我时间格式设置不对