楼主
wcymiss |
Q：如何按库存量对订单中的欠货进行分配？“订单”表是订单日期与欠货的明细，“库存”表是现有库存，现在需要根据订单时间的先后顺序，把库存里面的货分给客户，最终的结果就如“分配”表所示。同一个品名，订单时间早的，要把库存里面的货先给它分配。（下图依次为订单、分配、库存）
A：先将订单表按“品名”、“订单日期”进行升序排序。然后，按alt+F11，将下面的代码拷贝至“订单”表下。- Sub 按库存分配订单()
- Dim d, arr, i&, arrt(), k
- Set d = CreateObject("scripting.Dictionary") '定义字典
- With Sheets("库存")
- arr = .Range("A1").CurrentRegion.Value '将库存表区域赋值给数组
- For i = 2 To UBound(arr, 1)
- If d.Exists(arr(i, 1)) Then
- d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2) '库存的品名作为字典Key值，同品名的汇总库存量作为Item值。
- Else: d.Add arr(i, 1), arr(i, 2)
- End If
- Next i
- End With
- k = d.Items '将字典的Item赋值给数组
- arr = Range("A1").CurrentRegion.Value '将订单表区域赋值给数组
- ReDim arrt(1 To UBound(arr, 1), 1 To 2) '重定义数组arrt，以备赋值
- arrt(1, 1) = "可分配量": arrt(1, 2) = "备注"
- With Sheets("分配")
- .Cells.Clear '清楚即将要填写数据的区域
- .Range("a1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr '将数组arr也就是订单表的数据复制到分配表
- For i = 2 To UBound(arr, 1)
- If d.Exists(arr(i, 2)) Then
- arrt(i, 1) = Application.Min(arr(i, 5), d(arr(i, 2))) '比较库存与订单的大小，取最小值。
- d(arr(i, 2)) = d(arr(i, 2)) - arrt(i, 1) '扣除已分配的数量后赋值给Item
- arrt(i, 2) = arrt(i, 1) & "*已分配"
- Else: arrt(i, 1) = 0
- End If
- Next i
- .Range("a1").Offset(0, UBound(arr, 2)).Resize(UBound(arr, 1), 2) = arrt '数组复制到分配表
- Range("a1").Copy
- .Range("A1").CurrentRegion.Rows(1).PasteSpecial xlPasteFormats '设置标题行格式
- .Columns(4).NumberFormat = "yyyy-mm-dd" '将日期数据设置格式
- .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous '设置边框
- End With
- Set d = Nothing
- End Sub
 如何按库存量对订单进行分配？（vba字典）.rar
|