库存使用量计算

wenyuhui

请大神门帮帮忙，感谢  想实现功能如下:

当PO日期改变时,按下计算剩余量,重新计算使用数量,显示在F列,以此类推.并用D列剩余数量减去新订单数量结果更新到D列.

当PO日期无改变时,按下计算剩余量,不执行代码

目前程序只能实现按下按钮,将使用量存到E列,不能二次计算

wenyuhui

请大神和版主帮帮忙 感激不尽

寒山叶飞

这是你自己写的不

wenyuhui

寒山叶飞 发表于 2016-7-12 15:45
这是你自己写的不

思路和大部分代码是移植论坛大神的 具体谁的忘记了

wenyuhui

ding by myself

YZC51

请参考

1. Sub 汇总()
   
2.     Dim Arr, i%, j%, drow%, k%, ddrow%, d1, d2, d3, Brr(), k1
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     Set d2 = CreateObject("scripting.dictionary")
   
5.     Set d3 = CreateObject("scripting.dictionary")
   
6. 
   
7.     Dim sht As Worksheet        '定义sht 为工作表
   
8.    
   
9.     If Worksheets("汇总").Range("e2") = Worksheets("汇总").Range("d2") Then Exit Sub
   
10.     For Each sht In Worksheets
    
11.         With sht
    
12.         
    
13.             If (.Name <> "汇总") And (.Name = "09460600") Then
    
14.                 drow = .Range("a65536").End(xlUp).Row
    
15.                 Arr = .Range("a2:g" & drow)
    
16.                 For i = 2 To UBound(Arr)
    
17.                     d1(Arr(i, 1) & "@" & Arr(i, 2)) = d1(Arr(i, 1) & "@" & Arr(i, 2)) + Arr(i, 3) * Sheets("汇总").Range("D4")
    
18.                 Next
    
19.             ElseIf (.Name <> "汇总") And (.Name = "09460610") Then
    
20.                 drow = .Range("a65536").End(xlUp).Row
    
21.                 Arr = .Range("a2:g" & drow)
    
22.                 For i = 2 To UBound(Arr)
    
23.                     d1(Arr(i, 1) & "@" & Arr(i, 2)) = d1(Arr(i, 1) & "@" & Arr(i, 2)) + Arr(i, 3) * Sheets("汇总").Range("D5")
    
24.                 Next
    
25.                      
    
26.             ElseIf (.Name <> "汇总") And (.Name = "09460650") Then
    
27.                 drow = .Range("a65536").End(xlUp).Row
    
28.                 Arr = .Range("a2:g" & drow)
    
29.                 For i = 2 To UBound(Arr)
    
30.                     d1(Arr(i, 1) & "@" & Arr(i, 2)) = d1(Arr(i, 1) & "@" & Arr(i, 2)) + Arr(i, 3) * Sheets("汇总").Range("D6")
    
31.                 Next
    
32.             
    
33.             End If
    
34. 
    
35.         End With
    
36.      
    
37.     Next
    
38.    
    
39. '--------------------------------------copy-------------------------------------
    
40. 
    
41.     k1 = d1.keys
    
42.     ReDim Brr(0 To d1.Count, 1 To 4)
    
43.     For i = 0 To d1.Count - 1
    
44.         Brr(i, 1) = Split(k1(i), "@")(0)
    
45.         Brr(i, 2) = Split(k1(i), "@")(1)
    
46.     Next
    
47.     Worksheets("汇总").Range("a10").Resize(d1.Count, 2) = Brr    '通过数组把数据复制到目标区域中
    
48.     k = 0
    
49.     If Cells(9, 5 + k) <> ("PO" & (Range("d2")) & "使用数量") Then
    
50.         k = k + 1
    
51.         Cells(9, 5 + k) = "PO" & (Range("d2")) & "使用数量"
    
52.         Worksheets("汇总").Cells(10, 5 + k).Resize(d1.Count, 1) = Application.Transpose(d1.items)  '通过数组把数据复制到目标区域中
    
53.     End If
    
54. '------------------------------PO update------------------------------------------------
    
55. 
    
56.     Range("e9") = "PO" & (Range("d2")) & "使用数量"
    
57. 
    
58. '---------------------------------------------------------------------------------------
    
59. 
    
60.     Worksheets("汇总").Range("e10").Resize(d1.Count, 1) = Application.Transpose(d1.items)    '通过数组把数据复制到目标区域中
    
61.    
    
62. '--------------------------------------subtraction-------------------------------------
    
63. 
    
64.     ddrow = Worksheets("汇总").Range("a65531").End(xlUp).Row
    
65.     For j = 10 To ddrow
    
66.         Range("D" & j) = Range("C" & j) + Range("D" & j) - Range("E" & j)
    
67.         Range("c" & j) = 0
    
68.         If Range("D" & j) <= 0 Then
    
69.         Cells(j, 4).Font.ColorIndex = 3
    
70.     Else
    
71.         Cells(j, 4).Font.Color = RGB(0, 0, 255)
    
72.        End If
    
73.     Next
    
74.     For j = 10 To ddrow
    
75.         x = Cells(j, 4)
    
76.         Cells(j, 4) = x - Cells(j, 5)
    
77.     Next
    
78.     Worksheets("汇总").Range("e2") = Worksheets("汇总").[d2]
    
79. End Sub

复制代码

YZC51

详见附件，有修改
PMP BULK物料供销表 - Ver2.rar (22 KB, 下载次数: 22)

2016-7-15 22:42 上传

点击文件名下载附件

YZC51

文件中代码修改如下
For j = 10 To ddrow
修改为
For j = 10 To drow