[已解决]请老师帮忙 看看，能不能用VBA实现，谢谢

xhczq

刚在函数那边发了，因急用，并且没有说清楚，所以在这边再发一次，如果下重的老师，请谅解。
附件有详细说明，请老师帮忙看看，谢谢

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-19 15:58

是不是这样的结果？

跳转到最佳答案楼层

白雪高山

合并在一个表里，期初数用+数，发出用-数，数据透视表都能看出余库存，函数和ＶＢＡ也可实现，感觉ＶＢＡ要相对容易实现些

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, i&, j&, zf$, p$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. ReDim crr(1 To UBound(arr) - 1, 1 To 4)
   
6. brr = Sheet2.Range("a1").CurrentRegion
   
7. Range("a2:e60000").ClearContents
   
8. For i = 2 To UBound(arr)
   
9.     zf = arr(i, 1) & "," & arr(i, 2)
   
10.     d(zf) = d(zf) & "," & i
    
11. Next
    
12. For i = 3 To UBound(brr)
    
13.     zf = brr(i, 1) & "," & brr(i, 2)
    
14.     x = Split(d(zf), ",")
    
15.     y = brr(i, 3)
    
16.     p = ""
    
17.     For j = 1 To UBound(x)
    
18.         If arr(x(j), 5) < y Then
    
19.              y = y - arr(x(j), 5): arr(x(j), 5) = 0
    
20.         Else
    
21.             arr(x(j), 5) = arr(x(j), 5) - y
    
22.         End If
    
23.         If arr(x(j), 5) > 0 Then p = p & "," & x(j)
    
24.     Next
    
25.     d(zf) = p
    
26. Next
    
27. For i = 2 To UBound(arr)
    
28.     crr(i - 1, 1) = arr(i, 1)
    
29.     crr(i - 1, 2) = arr(i, 2)
    
30.     crr(i - 1, 3) = arr(i, 4)
    
31.     crr(i - 1, 4) = arr(i, 5)
    
32. Next
    
33. Range("a2").Resize(UBound(crr), 4) = crr
    
34. End Sub
    

复制代码

dsmch

是不是这样的结果？

xhczq

dsmch 发表于 2014-4-19 15:58
是不是这样的结果？

老师，你终于懂了，完全解决了，太爱你了，谢谢

xhczq

白雪高山 发表于 2014-4-19 15:10
合并在一个表里，期初数用+数，发出用-数，数据透视表都能看出余库存，函数和ＶＢＡ也可实现，感觉ＶＢＡ要 ...

谢谢你，我觉得出库没有录入对应的库位，透视表透不出来哈，这是个人认为的，楼下有老师帮我解决了，真高兴