关于货物先进先出

笨鸟飞不高 · 发表于 2021-2-18 12:53

有点空！！老贴练练手！！！

Sub AwTest()
Dim i&, ks&, js&, k&, cksl&, ck&, arr, brr, d As Object
Set d = CreateObject("Scripting.Dictionary")
With Sheet2
      .[a1].CurrentRegion.Sort key1:=.[a1], order1:=1, key2:=.[d1], order2:=1, Header:=xlYes
      arr = .[a1].CurrentRegion
      For i = 2 To UBound(arr)
         If Not d.exists(arr(i, 1) & "|ksRow") Then d(arr(i, 1) & "|ksRow") = i
         d(arr(i, 1) & "|jsRow") = i
      Next
End With
With Sheet1
      .[a1].CurrentRegion.Offset(1, 2) = ""
      brr = .[a1].CurrentRegion
      For i = 2 To UBound(brr)
         ks = d(brr(i, 1) & "|ksRow"): js = d(brr(i, 1) & "|jsRow")
         cksl = brr(i, 2)
         For k = ks To js
            ck = Application.Min(cksl, arr(k, 3))
            If brr(i, 3) = "" Then
                  brr(i, 3) = arr(k, 2) & "/" & ck: cksl = cksl - ck
            Else
                  brr(i, 3) = brr(i, 3) & ";" & arr(k, 2) & "/" & ck: cksl = cksl - ck
            End If
            If cksl = 0 Then Exit For
         Next
         If cksl > 0 Then MsgBox "商品" & brr(i, 1) & "库存不够，缺 " & cksl
      Next
      .[a1].CurrentRegion = brr
End With
End Sub

笨鸟飞不高 · 发表于 2021-2-18 13:04

先进先出.zip (15.28 KB, 下载次数: 61)

笨鸟飞不高 · 发表于 2021-6-25 22:08

本帖最后由笨鸟飞不高于 2021-6-29 15:05 编辑

笨鸟飞不高发表于 2021-2-18 13:04

上一楼的代码有BUG

66.zip (14.23 KB, 下载次数: 67)

笨鸟飞不高 · 发表于 2024-6-29 12:55

闲！继续练习！！

		自动登录	找回密码
密码			免费注册

[已解决] 关于货物先进先出