根据总库存删除 （进库 出库 返货）的问题

无聊的疯子

测试代码,结果中有很多是负数呢??

1. 
   
2. Private Sub Worksheet_Activate()
   
3. On Error Resume Next
   
4.   Sheets("总库存").Range("a4:m60000") = ""
   
5.   If Sheets("进库").Range("a4") = "" Then
   
6.     MsgBox "进库现在是空的，请先把货品录入到进库以后再看总库存！", vbInformation, "进库为空！"
   
7.     Exit Sub
   
8.   End If
   
9.   Dim 棋盘(1 To 65536, 1 To 12)
   
10.   Dim 行数, L As Byte
    
11.   Dim 进库, x, k
    
12.   Set d = CreateObject("scripting.dictionary")
    
13.   进库 = Sheets("进库").Range("a4:l" & Sheets("进库").Range("a65536").End(xlUp).Row)
    
14.   For x = 1 To UBound(进库)
    
15.     If d.exists(进库(x, 1)) Then
    
16.        行数 = d(进库(x, 1))
    
17.        For L = 3 To 12
    
18.          If L = 9 Or L = 11 Then L = L + 1
    
19.          棋盘(行数, L) = 棋盘(行数, L) + 进库(x, L)
    
20.        Next
    
21.      Else
    
22.        k = k + 1
    
23.        d(进库(x, 1)) = k
    
24.        For L = 1 To 12
    
25.          棋盘(k, L) = 进库(x, L)
    
26.        Next
    
27.     End If
    
28.   Next x
    
29.   Sheets("总库存").Range("a4").Resize(k, 12) = 棋盘
    
30. 
    
31.   If Sheets("出库").Range("a4") = "" Then
    
32.     MsgBox "出库现在是空的，如果想看库存，就直接看进库就可以了！", vbInformation, "出库还没有内容！"
    
33.     Exit Sub
    
34.   End If
    
35.   Dim 出库
    
36.   出库 = Sheets("出库").Range("a4:l" & Sheets("出库").Range("a65536").End(xlUp).Row)
    
37.   For x = 1 To UBound(出库)
    
38.    If d.exists(出库(x, 1)) Then
    
39.       行数 = d(出库(x, 1))
    
40.       For L = 3 To 12
    
41.         If L = 9 Or L = 11 Then L = L + 1
    
42.         棋盘(行数, L) = 棋盘(行数, L) - 出库(x, L)
    
43.       Next
    
44.     Else
    
45.       k = k + 1
    
46.       d(出库(x, 1)) = k
    
47.       For L = 1 To 12
    
48.         棋盘(k, L) = 出库(x, L)
    
49.       Next
    
50.     End If
    
51.   Next x
    
52.   Sheets("总库存").Range("a4").Resize(k, 12) = 棋盘
    
53. 
    
54.   If Sheets("返货").Range("a4") = "" Then
    
55. 
    
56.   Exit Sub
    
57.   End If
    
58.   Dim 返货
    
59.   返货 = Sheets("返货").Range("a4:m" & Sheets("返货").Range("a65536").End(xlUp).Row)
    
60.   For x = 1 To UBound(返货)
    
61.    If d.exists(返货(x, 2)) Then
    
62.       行数 = d(返货(x, 2))
    
63.       For L = 3 To 12
    
64.         If L = 9 Or L = 11 Then L = L + 1
    
65.         棋盘(行数, L) = 棋盘(行数, L) - 返货(x, L + 1)
    
66.       Next
    
67.     Else
    
68.       k = k + 1
    
69.       d(返货(x, 2)) = k
    
70.       For L = 1 To 12
    
71.         棋盘(k, L) = 返货(x, L + 1)
    
72.       Next
    
73.     End If
    
74.   Next x
    
75.   Sheets("总库存").Range("a4").Resize(k, 12) = 棋盘
    
76.   If Sheets("总库存").Range("O7").Value <> Sheets("总库存").Range("O8").Value Then
    
77.     MsgBox "进库或出库数据不对", vbInformation, "总库存提示"
    
78.   End If
    
79.   k = 0
    
80.   For x = 1 To UBound(进库)
    
81.     If 棋盘(d(进库(x, 1)), 8) = 0 Then
    
82.       If k = 0 Then k = x + 3
    
83.       If 棋盘(d(进库(x + 1, 1)), 8) <> 0 Then
    
84.         s = s & "," & k & ":" & x + 3
    
85.         k = 0
    
86.       End If
    
87.     End If
    
88.   Next
    
89.   s = Mid(s, 2)
    
90.   Sheets("进库").Range(s).Delete xlUp
    
91.   s = ""
    
92.   k = 0
    
93.   For x = 1 To UBound(出库)
    
94.     If 棋盘(d(出库(x, 1)), 8) = 0 Then
    
95.       If k = 0 Then k = x + 3
    
96.       If 棋盘(d(出库(x + 1, 1)), 8) <> 0 Then
    
97.         s = s & "," & k & ":" & x + 3
    
98.         k = 0
    
99.       End If
    
100.     End If
     
101.   Next
     
102.   s = Mid(s, 2)
     
103.   Sheets("出库").Range(s).Delete xlUp
     
104.     s = ""
     
105.   k = 0
     
106.   For x = 1 To UBound(返货)
     
107.     If 棋盘(d(返货(x, 1)), 8) = 0 Then
     
108.       If k = 0 Then k = x + 3
     
109.       If 棋盘(d(返货(x + 1, 1)), 8) <> 0 Then
     
110.         s = s & "," & k & ":" & x + 3
     
111.         k = 0
     
112.       End If
     
113.     End If
     
114.   Next
     
115.   s = Mid(s, 2)
     
116.   Sheets("返货").Range(s).Delete xlUp
     
117. End Sub
     
118. 
     

复制代码