一个办公用品出入库登记表，内详更新中，18楼最后一个问题求帮。

zhaogang1960

shengdingb 发表于 2014-2-11 22:13
再次感谢版主 zhaogang1960帮忙完善了计算库存的代码。 这几天除了 ...

放在模块中：

1. 
   
2. Sub 计算库存()
   
3.     Dim arr, brr(), i&, j&, s$, r, m&, d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Sheets("出入库记录").Range("A1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 6)
   
7.     For i = 2 To UBound(arr)
   
8.         s = arr(i, 1) & vbTab & arr(i, 2)
   
9.         r = d(s)
   
10.         If r = "" Then
    
11.             m = m + 1
    
12.             d(s) = m
    
13.             r = m
    
14.             For j = 1 To 3
    
15.                 brr(m, j) = arr(i, j)
    
16.             Next
    
17.             brr(m, 4) = arr(i, 6)
    
18.         End If
    
19.         If arr(i, 4) = "入库" Then
    
20.             brr(r, 5) = brr(r, 5) + arr(i, 5)
    
21.         ElseIf arr(i, 4) = "出库" Then
    
22.             brr(r, 6) = brr(r, 6) + arr(i, 5)
    
23.         End If
    
24.     Next
    
25.     For i = 1 To m
    
26.         brr(i, 6) = brr(i, 5) + brr(i, 6)
    
27.     Next
    
28.     With Sheets("库存")
    
29.         .Range("A1").CurrentRegion.Offset(1).ClearContents
    
30.         .Range("A2").Resize(m, 6) = brr
    
31.     End With
    
32. End Sub
    

复制代码

zhaogang1960

请看附件
窗口按钮计算库存.rar (29.51 KB, 下载次数: 168)

2014-2-11 22:40 上传

点击文件名下载附件

shengdingb

zhaogang1960 发表于 2014-2-11 22:40
请看附件

附件好像不对没反应，

shengdingb

zhaogang1960 发表于 2014-2-11 22:40
请看附件

不能用窗口里的 命令按钮控制吗？

zhaogang1960

shengdingb 发表于 2014-2-11 23:08
不能用窗口里的 命令按钮控制吗？

可以用原来的，但需要在每个工作表代码区都写代码，而放到模块中仅需要写一个即可

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, brr(), i&, j&, s$, r, m&, d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("出入库记录").Range("A1").CurrentRegion
   
5.     ReDim brr(1 To UBound(arr), 1 To 6)
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 1) & vbTab & arr(i, 2)
   
8.         r = d(s)
   
9.         If r = "" Then
   
10.             m = m + 1
    
11.             d(s) = m
    
12.             r = m
    
13.             For j = 1 To 3
    
14.                 brr(m, j) = arr(i, j)
    
15.             Next
    
16.             brr(m, 4) = arr(i, 6)
    
17.         End If
    
18.         If arr(i, 4) = "入库" Then
    
19.             brr(r, 5) = brr(r, 5) + arr(i, 5)
    
20.         ElseIf arr(i, 4) = "出库" Then
    
21.             brr(r, 6) = brr(r, 6) + arr(i, 5)
    
22.         End If
    
23.     Next
    
24.     For i = 1 To m
    
25.         brr(i, 6) = brr(i, 5) + brr(i, 6)
    
26.     Next
    
27.     With Sheets("库存")
    
28.         .Range("A1").CurrentRegion.Offset(1).ClearContents
    
29.         .Range("A2").Resize(m, 6) = brr
    
30.     End With
    
31. End Sub

复制代码

mmwwdd

看贴留名,记号一下

201228

哇， 你两前前后后唠了一周，真服！！！

第三根琴弦

shengdingb 发表于 2014-2-11 23:08
不能用窗口里的 命令按钮控制吗？

楼主，能不能把最后做好的分享一下啊？我下载的32楼附件，发现“库存“里面的“库存数量”不正确，它是入库的整数而没有减去出库！谢谢~~

youjiafish

菜鸟，跟着学习学习。EXCEL编程可是一点都不会啊

youjiafish

求楼主发一份完整版