仓库先进先出公式设置求教

lijian0448 · 发表于 2018-9-24 10:23

各路大神，有一个仓库先进先出问题求教，入库表格列出入库的品名、日期、库位、数量等信息，出库时列出品名和数量，求教库位、和入库日期两列公式如何设置，在输入品名和数量后能够显示最早入库产品且没有被发出的货位和入库信息，谢谢。

鄂龙蒙 · 发表于 2018-9-24 12:28

Sub 先进先出计算出库()
Dim m, n, x, z, i, j, arr, brr, ar, br(), a, b, ai, s
Dim d As Object, k, t
Set d = CreateObject("scripting.dictionary")
ar = Range("A2").CurrentRegion
With Sheet1
arr = .Range("A3:D" & UBound(ar) + 4)
.[H1:K10000] = ""
.[H1].Resize(UBound(arr), 4) = arr
.Range("H1:K" & UBound(arr) + 1).Sort Key1:=.Range("I1"), Key2:=.Range("H1")
arr = .Range("H1").CurrentRegion
End With
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 2)) Then
m = 1: ReDim brr(1 To 4, 1 To m)
Else
brr = d(arr(i, 2))
m = UBound(brr, 2) + 1: ReDim Preserve brr(1 To 4, 1 To m)
End If
For j = 1 To 4: brr(j, m) = arr(i, j): Next
d(arr(i, 2)) = brr
Next
k = d.keys: t = d.items
For i = 2 To UBound(ar)
For x = 0 To d.Count - 1
If ar(i, 2) = k(x) Then
If t(x)(3, 1) >= ar(i, 3) Then
n = n + 1: ReDim Preserve br(1 To 5, 1 To n)
br(1, n) = ar(i, 1)
br(2, n) = k(x)
br(3, n) = ar(i, 3)
br(4, n) = t(x)(4, 1)
br(5, n) = t(x)(1, 1)
Else
a = 0
For y = 1 To UBound(t(x), 2)
a = a + t(x)(3, y)
If a >= ar(i, 3) Then ai = y: Exit For
Next
b = 0
For y = 1 To ai - 1
b = b + t(x)(3, y)
n = n + 1: ReDim Preserve br(1 To 5, 1 To n)
For z = 2 To 4
br(z, n) = t(x)(z, y)
Next
br(1, n) = ar(i, 1)
br(5, n) = t(x)(1, y)
Next
n = n + 1: ReDim Preserve br(1 To 5, 1 To n)
br(1, n) = ar(i, 1)
br(2, n) = k(x)
br(3, n) = ar(i, 3) - b
br(4, n) = t(x)(4, ai)
br(5, n) = t(x)(1, ai)
End If
End If
Next
Next
s = Range("A2:E2")
[H2].Resize(1, 5) = s: [H3].Resize(n, 5) = Application.Transpose(br)
Set d = Nothing
End Sub

复制代码

鄂龙蒙 · 发表于 2018-9-24 12:39

hcm19522 · 发表于 2018-9-24 15:05

D3:E10{=INDEX(IF(COLUMN(A1)=1,入库!$D$3:$D$13,入库!$A$3:$A$13),MATCH(,0/((入库!$B$3:$B$13=$B3)*SUMIF(OFFSET(入库!$B$3,,,ROW($1:$11)),入库!$B$3:$B$13,入库!$C$3:$C$13)>=SUMIF($B$3:$B3,$B3,$C$3:$C3)),))

鄂龙蒙 · 发表于 2018-9-24 16:03

Sub 先进先出计算出库()
Range("H1:L10000") = ""
Dim m, n, x, y, z, i, j, arr, brr, ar, br(), a, b, ai, s
Dim d As Object, k, t
Set d = CreateObject("scripting.dictionary")
ar = Range("A2").CurrentRegion
With Sheet1
arr = .Range("A3:D" & UBound(ar) + 4)
.[H1:K10000] = ""
.[H1].Resize(UBound(arr), 4) = arr
.Range("H1:K" & UBound(arr) + 1).Sort Key1:=.Range("I1"), Key2:=.Range("H1")
arr = .Range("H1").CurrentRegion
.Range("H1:K10000") = ""
End With
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 2)) Then
m = 1: ReDim brr(1 To 4, 1 To m)
Else
brr = d(arr(i, 2))
m = UBound(brr, 2) + 1: ReDim Preserve brr(1 To 4, 1 To m)
End If
For j = 1 To 4: brr(j, m) = arr(i, j): Next
d(arr(i, 2)) = brr
Next
k = d.keys: t = d.items
For i = 2 To UBound(ar)
For x = 0 To d.Count - 1
If ar(i, 2) = k(x) Then
If t(x)(3, 1) >= ar(i, 3) Then
n = n + 1: ReDim Preserve br(1 To 5, 1 To n)
br(1, n) = ar(i, 1)
br(2, n) = k(x)
br(3, n) = ar(i, 3)
br(4, n) = t(x)(4, 1)
br(5, n) = t(x)(1, 1)
t(x)(3, 1) = t(x)(3, 1) - ar(i, 3)
Else
a = 0
For y = 1 To UBound(t(x), 2)
a = a + t(x)(3, y)
If a >= ar(i, 3) Then ai = y: Exit For
Next
If a < ar(i, 3) Then MsgBox "【" & k(x) & "】计划出库数【" & _
ar(i, 3) & "】超过库存量【" & a & "】了！", vbOKCancel, "提示：": Exit Sub
b = 0
For y = 1 To ai - 1
b = b + t(x)(3, y)
If t(x)(3, y) <> 0 Then
n = n + 1: ReDim Preserve br(1 To 5, 1 To n)
For z = 2 To 4
br(z, n) = t(x)(z, y)
Next
br(1, n) = ar(i, 1)
br(5, n) = t(x)(1, y)
End If
t(x)(3, 1) = 0
Next
n = n + 1: ReDim Preserve br(1 To 5, 1 To n)
br(1, n) = ar(i, 1)
br(2, n) = t(x)(2, ai)
br(3, n) = ar(i, 3) - b
br(4, n) = t(x)(4, ai)
br(5, n) = t(x)(1, ai)
t(x)(3, ai) = a - ar(i, 3)
End If
End If
Next
Next
s = Range("A2:E2")
[H2].Resize(1, 5) = s: [H3].Resize(n, 5) = Application.Transpose(br)
Set d = Nothing
End Sub

复制代码

鄂龙蒙 · 发表于 2018-9-24 16:04

鄂龙蒙 · 发表于 2018-9-24 17:36

qiu701 · 发表于 2018-9-24 20:12

把代码复制什么地方？

micch · 发表于 2018-9-24 21:21

你这问题的答案就不能模拟一下，C7出库900对应的应该是A-1,A-2两个货位，结果咋写？如果出货对应3,4个货位呢？如果要合并单元格，那就麻烦了，得辅助；

ttyong · 发表于 2018-9-25 09:05

不需要考虑入库/出库的日期的吗，2018-18是什么日期。

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

[已解决] 仓库先进先出公式设置求教

评分