字典数据运算后匹配

linwanglian

《原始数据区》（特征1&特征2），匹配《标准件》里面的K列&M列，如果相同，判断1，《原始数据》库存数>《标准件》数量；判断2，《原始数据》长度>《标准件》长度，把《原始数据》代码，填写到D列。同时《原始数据》库存数-《标准件》数量，再返回《原始数据》N列。


编写目的：用原始数据区库存零件，长改短后，使用。同时把改造的库存数更新。
文件里面代码是VB6代码。
遇到的问题是，标准件里面填写的改造数量<库存数减去的数量。感觉是字典重新赋值的时候，重复扣减了。找不到原因。

1. Sub 匹配()
   
2.     Dim ar, arr, I, J, R1, Y1, S
   
3.     Set XL = GetObject(, "Excel.Application")
   
4.     Set XLB = XL.Workbooks("清单工具.XLSX")
   
5.     Set XLS = XLB.Worksheets("原始数据区")
   
6.     Set XLSB = XLB.Worksheets("标准件")
   
7.     RR1 = XLS.[C65536].End(xlUp).Row
   
8.     arr = XLS.Range("A1:z" & RR1)
   
9.     R1 = XLSB.[C65536].End(xlUp).Row
   
10.     ar = XLSB.Range("A1:AJ" & R1)
    
11.     XL.ScreenUpdating = False
    
12.     Set d = CreateObject("Scripting.Dictionary")
    
13. 
    
14.     For I = 1 To UBound(arr)
    
15.         KM = arr(I, 3) & "|" & arr(I, 10) & arr(I, 12) & "|" & arr(I, 11)
    
16.         d(KM) = arr(I, 13)
    
17.     Next I
    
18.     K = d.KEYS
    
19.     For I = 2 To R1
    
20.         BM = ar(I, 11) & ar(I, 13)
    
21.         BC = ar(I, 12)
    
22.         BS = ar(I, 6)
    
23.         For S = 0 To UBound(K)
    
24.             t = Split(K(S), "|")
    
25.             If ar(I, 13) = "普通模板" And IsEmpty(ar(I, 5)) Then   '---------------------------------普板----------------------------------------------------1
    
26.                 If BC <= 1100 Then     '------------------------------------------------1100以内不能拼接----------------------2
    
27.                     If t(1) = BM Then     '------------------------匹配字典----------------------------------------3
    
28.                         NU = d((K(S)))
    
29.                         If NU > BS Then  '-----------------------------库存数大于改制数------------------4
    
30.                             If t(2) - BC < 50 And t(2) - BC > 0 Then    '-------------去50以内---5
    
31.                                 XLSB.Cells(I, 4) = t(0)
    
32.                                 XLSB.Cells(I, 5) = BS
    
33.                                 d(K(S)) = NU - BS    '字典库存-出库数
    
34.                             ElseIf t(2) - BC >= 50 And t(2) - BC < 100 Then    '--------去100以内---5
    
35.                                 XLSB.Cells(I, 4) = t(0)
    
36.                                 XLSB.Cells(I, 5) = BS
    
37.                                 d(K(S)) = NU - BS    '字典库存-出库数
    
38.                             ElseIf t(2) - BC >= 100 And t(2) - BC < 150 Then    '-------去150以内---5
    
39.                                 XLSB.Cells(I, 4) = t(0)
    
40.                                 XLSB.Cells(I, 5) = BS
    
41.                                 d(K(S)) = NU - BS    '字典库存-出库数
    
42.                             ElseIf t(2) - BC >= 150 And t(2) - BC < 200 Then    '-------去200以内---5
    
43.                                 XLSB.Cells(I, 4) = t(0)
    
44.                                 XLSB.Cells(I, 5) = BS
    
45.                                 d(K(S)) = NU - BS    '字典库存-出库数
    
46.                             End If
    
47.                         ElseIf NU > BS * 2 Then    '--------------------库存数大于改制数*2----------------4
    
48.                             If t(2) - BC * 2 < 100 And t(2) - BC >= 50 Then    '-----------去100以内---5
    
49.                                 XLSB.Cells(I, 4) = t(0)
    
50.                                 XLSB.Cells(I, 5) = BS / 2
    
51.                                 d(K(S)) = NU - BS / 2  '字典库存-出库数
    
52.                             ElseIf t(2) - BC * 2 < 150 And t(2) - BC >= 100 Then    '------去150以内---5
    
53.                                 XLSB.Cells(I, 4) = t(0)
    
54.                                 XLSB.Cells(I, 5) = BS / 2
    
55.                                 d(K(S)) = NU - BS / 2  '字典库存-出库数
    
56.                             ElseIf t(2) - BC * 2 < 200 And t(2) - BC >= 150 Then    '------去200以内---5
    
57.                                 XLSB.Cells(I, 4) = t(0)
    
58.                                 XLSB.Cells(I, 5) = BS / 2
    
59.                                 d(K(S)) = NU - BS / 2  '字典库存-出库数
    
60.                             End If
    
61.                         End If    '------------------------------------------------------------4
    
62.                     End If    '--------------------------------------------------------------------3
    
63.                 End If    '------------------------------------------------------------------------------2
    
64.             End If
    
65.         Next
    
66.     Next
    
67.     For J = 1 To RR1
    
68.         If d.Exists(arr(J, 3) & "|" & arr(J, 10) & arr(J, 12) & "|" & arr(J, 11)) Then
    
69.             t = d(arr(J, 3) & "|" & arr(J, 10) & arr(J, 12) & "|" & arr(J, 11))
    
70.             XLS.Cells(J, 14) = t
    
71.         End If
    
72.     Next J
    
73. 
    
74.     Set d = Nothing
    
75. 
    
76.     XL.ScreenUpdating = True
    
77.     Set XL = Nothing
    
78.     Set XLB = Nothing
    
79.     Set XLS = Nothing
    
80.     Erase arr
    
81.     Erase ar
    
82. End Sub

复制代码