求助如何做订单处理

sxbjzjf110

参与一下。。。。。

yanglinzi

请测试。。

feilanga

1. Sub tj()
   
2.     Dim dic As Object
   
3.     Set dic = CreateObject("scripting.dictionary")
   
4.     arr = Sheet4.Range("A1:I" & Sheet4.Cells(Rows.Count, 2).End(xlUp).Row) '订单明细
   
5.     ReDim brr(1 To UBound(arr), 1 To 8)
   
6.     For i = 4 To UBound(arr)
   
7.         Key = arr(i, 4) & "|" & arr(i, 5) & "|" & arr(i, 6) & "|" & arr(i, 7) '名称+规格+单位+门类
   
8.         If Not dic.Exists(Key) Then
   
9.             k = k + 1
   
10.             dic(Key) = k
    
11.             brr(k, 1) = k
    
12.             brr(k, 2) = arr(i, 4)
    
13.             brr(k, 3) = arr(i, 5)
    
14.             brr(k, 4) = arr(i, 6)
    
15.             brr(k, 5) = arr(i, 7)
    
16.             brr(k, 6) = arr(i, 8) '订单数量
    
17.         Else
    
18.             s = dic(Key)
    
19.             brr(s, 6) = brr(s, 6) + arr(i, 8)
    
20.         End If
    
21.     Next
    
22.     arr = Sheet6.Range("A1:J" & Sheet6.Cells(Rows.Count, 1).End(xlUp).Row) '月报表
    
23.     For i = 4 To UBound(arr)
    
24.         Key = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) '名称+规格+单位+门类
    
25.         If Not dic.Exists(Key) Then
    
26.             k = k + 1
    
27.             dic(Key) = k
    
28.             brr(k, 1) = k
    
29.             brr(k, 2) = arr(i, 1)
    
30.             brr(k, 3) = arr(i, 2)
    
31.             brr(k, 4) = arr(i, 3)
    
32.             brr(k, 5) = arr(i, 4)
    
33.             brr(k, 7) = arr(i, 6) '入库总量
    
34.             brr(k, 8) = brr(k, 6) - brr(k, 7) '需产数量
    
35.             If brr(k, 8) < 0 Then brr(k, 8) = 0
    
36.         Else
    
37.             s = dic(Key)
    
38.             brr(s, 7) = brr(s, 7) + arr(i, 6) '入库总量累加
    
39.             brr(s, 8) = brr(s, 6) - brr(s, 7) '需产数量
    
40.             If brr(s, 8) < 0 Then brr(s, 8) = 0
    
41.         End If
    
42.     Next
    
43.     Sheet11.Range("A4:i" & Rows.Count).ClearContents  '清空结果输出区
    
44.     Sheet11.Range("a4").Resize(k, 8) = brr
    
45. End Sub

复制代码

yynrzwh