[已解决]比较简单的问题

美斯特邦威

出入库数量统计的，根据入库料号得出唯一料号，并计算数量，减去同一料号的出库量，得出库存。
已附上附件，谢谢！

最佳答案

月排行榜 / 总排行榜

huoxieshen

2012-10-10 11:08

美斯特邦威 发表于 2012-10-10 09:23
附件上来了
谢谢

猜一个，试试这个吧，两张表的格式完全不同，对应都对应不好~~

1. Sub text()
   
2.   Dim arr(), brr(1 To 60000, 1 To 6), k As Integer, i As Integer, h As Integer
   
3.   Dim a As Object
   
4.   Set d = CreateObject("scripting.dictionary")
   
5.   arr = Sheet2.Range("a3:l" & Sheet2.Range("a65536").End(3).Row).Value
   
6.   For i = 1 To UBound(arr)
   
7.       If Not d.exists(arr(i, 5)) Then
   
8.          k = k + 1
   
9.          d(arr(i, 5)) = k
   
10.          brr(k, 1) = arr(i, 5)
    
11.          brr(k, 2) = arr(i, 7)
    
12.          brr(k, 4) = arr(i, 11)
    
13.          brr(k, 5) = 0
    
14.          brr(k, 6) = brr(k, 4) - brr(k, 5)
    
15.        Else
    
16.          h = d(arr(i, 5))
    
17.          brr(h, 4) = brr(h, 4) + arr(i, 11)
    
18.          brr(h, 6) = brr(h, 4) - brr(h, 5)
    
19.       End If
    
20.   Next
    
21.   arr = Sheet3.Range("a3:i" & Sheet3.Range("a65536").End(3).Row).Value
    
22.   For i = 1 To UBound(arr)
    
23.       If d.exists(arr(i, 4)) Then
    
24.          h = d(arr(i, 4))
    
25.          brr(h, 5) = brr(h, 5) + arr(i, 8)
    
26.          brr(h, 6) = brr(h, 4) - brr(h, 5)
    
27.       Else
    
28.          k = k + 1
    
29.          d(arr(i, 4)) = k
    
30.          brr(k, 1) = arr(i, 4)
    
31.          brr(k, 2) = arr(i, 6)
    
32.          brr(k, 4) = 0
    
33.          brr(k, 5) = arr(i, 8)
    
34.          brr(k, 6) = brr(k, 4) - brr(k, 5)
    
35.       End If
    
36.   Next
    
37.   With Sheet1
    
38.        .Range("a3:f65536").ClearContents
    
39.        .Range("a3").Resize(d.Count, 6) = brr
    
40.   End With
    
41. End Sub
    

复制代码

跳转到最佳答案楼层

zjdh

附件飞了！        

美斯特邦威

附件上来了
谢谢

huoxieshen

美斯特邦威 发表于 2012-10-10 09:23
附件上来了
谢谢

入库明细表里的物品料号对应出库明细表的哪一列？？

zjdh

出库单的物料，入库明细表中都不存在，如何按入库明细建立物料总表？！

huoxieshen

美斯特邦威 发表于 2012-10-10 09:23
附件上来了
谢谢

猜一个，试试这个吧，两张表的格式完全不同，对应都对应不好~~

1. Sub text()
   
2.   Dim arr(), brr(1 To 60000, 1 To 6), k As Integer, i As Integer, h As Integer
   
3.   Dim a As Object
   
4.   Set d = CreateObject("scripting.dictionary")
   
5.   arr = Sheet2.Range("a3:l" & Sheet2.Range("a65536").End(3).Row).Value
   
6.   For i = 1 To UBound(arr)
   
7.       If Not d.exists(arr(i, 5)) Then
   
8.          k = k + 1
   
9.          d(arr(i, 5)) = k
   
10.          brr(k, 1) = arr(i, 5)
    
11.          brr(k, 2) = arr(i, 7)
    
12.          brr(k, 4) = arr(i, 11)
    
13.          brr(k, 5) = 0
    
14.          brr(k, 6) = brr(k, 4) - brr(k, 5)
    
15.        Else
    
16.          h = d(arr(i, 5))
    
17.          brr(h, 4) = brr(h, 4) + arr(i, 11)
    
18.          brr(h, 6) = brr(h, 4) - brr(h, 5)
    
19.       End If
    
20.   Next
    
21.   arr = Sheet3.Range("a3:i" & Sheet3.Range("a65536").End(3).Row).Value
    
22.   For i = 1 To UBound(arr)
    
23.       If d.exists(arr(i, 4)) Then
    
24.          h = d(arr(i, 4))
    
25.          brr(h, 5) = brr(h, 5) + arr(i, 8)
    
26.          brr(h, 6) = brr(h, 4) - brr(h, 5)
    
27.       Else
    
28.          k = k + 1
    
29.          d(arr(i, 4)) = k
    
30.          brr(k, 1) = arr(i, 4)
    
31.          brr(k, 2) = arr(i, 6)
    
32.          brr(k, 4) = 0
    
33.          brr(k, 5) = arr(i, 8)
    
34.          brr(k, 6) = brr(k, 4) - brr(k, 5)
    
35.       End If
    
36.   Next
    
37.   With Sheet1
    
38.        .Range("a3:f65536").ClearContents
    
39.        .Range("a3").Resize(d.Count, 6) = brr
    
40.   End With
    
41. End Sub
    

复制代码