关于数据分配的问题

brianlong

如附件 订单中每个型号的总数跟记录中每个型号的总数是对应的，最小包装是10000，因为装箱和批次比较散，现需要将每个型号的订单号依次对应到每一行去，保证每个型号的总数跟记录中每个型号的总数不会错，第一次处理这种问题，请求各位帮忙

jaxxcyh

1. Sub test()
   
2.     Sheets("记录").Range("E2:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value = ""
   
3.    
   
4.     Dim arr_dingdan(), arr_jilu()
   
5.     arr_dingdan = Sheets("订单信息").[a1].CurrentRegion.Value
   
6.     arr_jilu = Sheets("记录").[a1].CurrentRegion.Value
   
7.    
   
8.     For i = 2 To UBound(arr_dingdan, 1)    '逐个处理每笔订单
   
9.         j = arr_dingdan(i, 3) / 10000      '将订单拆开为若干个10000
   
10.         
    
11.         Do
    
12.             '"记录"表中寻找匹配的记录行
    
13.             k = 2
    
14.             Do While arr_jilu(k, 5) <> "" Or arr_jilu(k, 2) <> arr_dingdan(i, 2)
    
15.                 k = k + 1
    
16.             Loop
    
17.             
    
18.             If arr_jilu(k, 2) = arr_dingdan(i, 2) Then   '如果型号一致
    
19.                 arr_jilu(k, 5) = arr_dingdan(i, 1)       '就在记录里写入订单号
    
20.                 j = j - 1
    
21.             End If
    
22.         Loop Until j = 0
    
23.     Next
    
24.    
    
25.     '输出结果
    
26.     For i = 2 To UBound(arr_jilu, 1)
    
27.         Sheets("记录").Cells(i, 5).Value = arr_jilu(i, 5)
    
28.     Next
    
29. End Sub
    

复制代码

jaxxcyh

附件..............

1. Sub test()
   
2.     Sheets("记录").Range("E2:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value = ""
   
3.    
   
4.     Dim arr_dingdan(), arr_jilu()
   
5.     arr_dingdan = Sheets("订单信息").[a1].CurrentRegion.Value
   
6.     arr_jilu = Sheets("记录").[a1].CurrentRegion.Value
   
7.    
   
8.     For i = 2 To UBound(arr_dingdan, 1)    '逐个处理每笔订单
   
9.         j = arr_dingdan(i, 3) / 10000      '将订单拆开为若干个10000
   
10.         
    
11.         Do
    
12.             '"记录"表中寻找匹配的记录行
    
13.             k = 2
    
14.             Do While arr_jilu(k, 5) <> "" Or arr_jilu(k, 2) <> arr_dingdan(i, 2)
    
15.                 k = k + 1
    
16.             Loop
    
17.             
    
18.             If arr_jilu(k, 2) = arr_dingdan(i, 2) Then   '如果型号一致
    
19.                 arr_jilu(k, 5) = arr_dingdan(i, 1)       '就在记录里写入订单号
    
20.                 j = j - 1
    
21.             End If
    
22.         Loop Until j = 0
    
23.     Next
    
24.    
    
25.     '输出结果
    
26.     For i = 2 To UBound(arr_jilu, 1)
    
27.         Sheets("记录").Cells(i, 5).Value = arr_jilu(i, 5)
    
28.     Next
    
29. End Sub
    

复制代码

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&
   
    ar = Worksheets(2).[A1].CurrentRegion.Value
   
    With [A1].CurrentRegion
        With .Columns(.Columns.Count)
            Intersect(.Offset(), .Offset(1)).Clear
        End With
        br = .Value
        For i = 2 To UBound(ar)
            For j = 2 To UBound(br)
                If Len(br(j, 5)) = False Then
                    If ar(i, 3) = 0 Then Exit For
                    If br(j, 2) = ar(i, 2) Then
                        br(j, 5) = ar(i, 1)
                        ar(i, 3) = ar(i, 3) - br(j, 4)
                    End If
                End If
            Next j
        Next i
        .Value = br
    End With
   
    Beep
End Sub

gwjkkkkk

参与一下。。。