求助数量分配代码

海好呀

sulgz 发表于 2023-5-27 16:28
是要求编程

Sub 分配退货()
Application.ScreenUpdating = False
      Dim arr, brr, crr, i%, j%
      Set d1 = CreateObject("Scripting.Dictionary")
      Set d2 = CreateObject("Scripting.Dictionary")
       arr = Range("b2:d" & Cells(Rows.Count, 2).End(xlUp).Row)
       brr = Range("f2:g" & Cells(Rows.Count, 7).End(xlUp).Row)
       ReDim crr(1 To UBound(arr), 1 To 1)
       For i = 1 To UBound(brr)
              d1(brr(i, 1)) = brr(i, 2)
       Next i
       For j = 1 To UBound(arr)
             If d1.exists(arr(j, 1)) Then
                    d2(arr(j, 1)) = d2(arr(j, 1)) + arr(j, 2)
                    If d2(arr(j, 1)) < d1(arr(j, 1)) Then
                            crr(j, 1) = arr(j, 2)
                    Else
                            crr(j, 1) = arr(j, 2) - (d2(arr(j, 1)) - d1(arr(j, 1)))
                    End If
                    If crr(j, 1) < 0 Then crr(j, 1) = 0
             End If
       Next j
       Cells(2, 4).Resize(UBound(arr), 1) = crr
Application.ScreenUpdating = True
End Sub

gwjkkkkk

sulgz 发表于 2023-5-27 16:48
大佬，做反了。
是根据右边退货数量分配到左边列订单里

请参考。。。

sulgz

dambcer 发表于 2023-5-27 17:42
参与一下

大神，还有一个条件忘记加了。
当右边退回数量大于左边列售后时，在分配到同类条码最后一个时，将剩余退货数量都放到最后那个那里

sulgz

gwjkkkkk 发表于 2023-5-27 18:11
请参考。。。

大神，还有一个条件忘记加了。
当右边退回数量大于左边列售后时，在分配到同类条码最后一个时，将剩余退货数量都放到最后那个那里

sulgz

gwjkkkkk 发表于 2023-5-27 18:11
请参考。。。

还有，这代码要运行2次数据才正确

海好呀

sulgz 发表于 2023-5-27 18:49
大神，还有一个条件忘记加了。
当右边退回数量大于左边列售后时，在分配到同类条码最后一个时，将剩余退 ...

看下是不是你要的

gwjkkkkk

sulgz 发表于 2023-5-27 18:49
大神，还有一个条件忘记加了。
当右边退回数量大于左边列售后时，在分配到同类条码最后一个时，将剩余退 ...

请参考附件。。。

nouce

试试这个，能不能不满足需求

sulgz

nouce 发表于 2023-5-28 00:01
试试这个，能不能不满足需求

谢谢