发货明细统计

LIUZHU

heaven_911 发表于 2012-9-4 09:26
第一次没发上来 继续补上

因为水平不够，所以程序写的很长，还请高手多多指点，另请楼主看是否符合要求

1. Private Sub CommandButton1_Click()
   
2.     Dim Arr, Brr, Crr, Drr, Err, i%, j%, n%, m%, Dkey, Expln$
   
3.     Dim Dic1 As New Dictionary, Dic2 As New Dictionary
   
4.     Arr = Range("A1").CurrentRegion.Value
   
5.    
   
6.     '利用字典剔除品名重复项
   
7.     For i = 2 To UBound(Arr)
   
8.         If Not Dic1.Exists(Arr(i, 2)) Then
   
9.             n = n + 1
   
10.             Dic1(Arr(i, 2)) = Array(Arr(i, 2), Arr(i, 3))
    
11.             Dic2(Arr(i, 2)) = n
    
12.         End If
    
13.     Next
    
14.    
    
15.     Brr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Dic1.Items))
    
16.     Dic1.RemoveAll
    
17.     ReDim Crr(1 To UBound(Brr), 1 To 2)
    
18.     For i = 2 To UBound(Arr)
    
19.         n = Dic2(Arr(i, 2))
    
20.         If Crr(n, 2) = "" Then
    
21.             Crr(n, 1) = Arr(i, 4) - Arr(i, 5)
    
22.             Crr(n, 2) = Arr(i, 6)
    
23.         Else
    
24.             Crr(n, 1) = Crr(n, 1) + Arr(i, 4) - Arr(i, 5)
    
25.             '设置m表示，m=1表示入库，m=-1表示出库
    
26.             If Arr(i, 4) > 0 Then
    
27.                 m = 1
    
28.             Else
    
29.                 m = -1
    
30.             End If
    
31.             
    
32.             '先将已存在的数据进行拆分，并加入字典
    
33.             Drr = Split(Crr(n, 2), "+")
    
34.             Crr(n, 2) = ""
    
35.             For j = 0 To UBound(Drr)
    
36.                 Err = Split(Drr(j), "*")
    
37.                 If UBound(Err) = 1 Then
    
38.                     Dic1(Err(0)) = Val(Err(1))
    
39.                 Else
    
40.                     Dic1(Err(0)) = 1
    
41.                 End If
    
42.             Next
    
43.                
    
44.             '将需要对比计算的数据进行拆分，并加入字典
    
45.             Drr = Split(Arr(i, 6), "+")
    
46.             For j = 0 To UBound(Drr)
    
47.                 Err = Split(Drr(j), "*")
    
48.                 If UBound(Err) = 1 Then
    
49.                     Dic1(Err(0)) = Dic1(Err(0)) + Val(Err(1)) * m
    
50.                 Else
    
51.                     Dic1(Err(0)) = Dic1(Err(0)) + Val(Err(0)) * m
    
52.                 End If
    
53.             Next
    
54.                
    
55.                 For Each Dkey In Dic1.Keys
    
56.                     
    
57.                     '将字典的数据用"+"号和"*"号连接起来
    
58.                     Expln = ""
    
59.                     If Dic1(Dkey) > 1 Then
    
60.                         Expln = Dkey & "*" & Dic1(Dkey)
    
61.                     ElseIf Dic1(Dkey) = 1 Then
    
62.                         Expln = Dkey
    
63.                     End If
    
64.                     
    
65.                     If Expln <> "" Then
    
66.                         If Crr(n, 2) = "" Then
    
67.                             Crr(n, 2) = Crr(n, 2) & Expln
    
68.                         Else
    
69.                             Crr(n, 2) = Crr(n, 2) & "+" & Expln
    
70.                         End If
    
71.                     End If
    
72.                 Next
    
73.         End If
    
74.         Dic1.RemoveAll
    
75.     Next
    
76.         
    
77.     With Sheets("基础表")
    
78.         .Cells.ClearContents
    
79.         .Activate
    
80.         .Range("A1:D1").Value = Array("品名", "单位", "结存", "备注")
    
81.         .Range("A2").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    
82.         .Range("C2").Resize(UBound(Crr), UBound(Crr, 2)) = Crr
    
83.     End With
    
84. End Sub

复制代码

LIUZHU

忘记发附件了，附件在此

heaven_911

哇 有这么多高手啊 还没来及细看 谢谢先

heaven_911

10楼 KCFONG兄
品名        单位        结存        备注
基布,米                748        50*10+40*4+88
浆料,KG                500        50*10
皮革,米                710        40*14+150
测试出来结果如上，品名中把单位合并在里面了。

heaven_911

11楼LIUZHU兄
测试2组数据：
日期        品名        单位        入库数量        出库数量        备注
9月1日        基布        米        1000                50*10+40*10+56+44
9月2日        浆料        KG        1000                50*20
9月3日        皮革        米        1000                40*20+35+36+37+38+39+15
9月4日        基布        米                626        50*5+40*8+56
9月5日        浆料        KG                750        50*15
9月6日        皮革        米                645        40*13+35+37+38+15
9月1日        基布        米        1000                50*10+40*10+56+44
9月2日        浆料        KG        1000                50*20
9月3日        皮革        米        1000                40*20+35+36+37+38+39+15
9月4日        基布        米                626        50*5+40*8+56
9月5日        浆料        KG                750        50*15
9月6日        皮革        米                645        40*13+35+37+38+15

结果如下：
品名        单位        结存        备注
基布        米        748        50*10+40*4+44*45
浆料        KG        500        50*10
皮革        米        710        40*14+36*37+39*40
明细发现错误了，小弟资质浅，看不懂哦，不知如何修改!
望高手继续支招

heaven_911

840205910 发表于 2012-9-4 10:35
日期        品名        单位        规格        入库数        入库量        出库数        出库量     ...

这种格式考虑过，但有时收一款基布会有几百件的，如果一笔笔输入，工作量太大，要求有明细的目的是为了核对，有时标签会看不清，如果弄错了，可以查看明细发现，不然光一个数字，到盘点才发现，就晚了。

netfly168

学习了，谢谢楼主分享

lee1892

此帖我收录到我的数据结构帖子里了，详见：http://club.excelhome.net/forum. ... 920&pid=6844034