关于货物先进先出

搁[浅灬 · 发表于 2012-7-31 21:58

本人想要根据入库时间早晚出库，做到先进先出，在自动输出到表单写明具体仓库出货量，就是表格中的出库仓库自动生成。
各位大大，谢谢啦{:soso_e100:}

66.rar (1.64 KB, 下载次数: 583)

yangyangzhifeng · 发表于 2012-7-31 23:53

试试

Sub test()
Dim arr, i&, d As Object, st1$, st2$
Dim brr, x&, j&, temp1, temp2&
Set d = CreateObject("scripting.dictionary")
Sheet2.Range("a1").CurrentRegion.Sort key1:="商品名称", order1:=xlAscending, key2:="入库时间", order2:=xlAscending, header:=xlYes
arr = Sheet2.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
st1 = arr(i, 1)
st2 = arr(i, 2) & "/" & arr(i, 3)
If Not d.exists(st1) Then
d(st1) = st2
Else
d(st1) = d(st1) & "|" & st2
End If
Next
brr = Sheet1.Range("A2", "c" & Sheet1.Range("a65536").End(xlUp).Row)
For i = 1 To UBound(brr)
st1 = brr(i, 1)
st2 = ""
If d.exists(st1) Then
x = brr(i, 2)
temp1 = Split(d(st1), "|")
For j = 0 To UBound(temp1)
temp2 = Split(temp1(j), "/")(1)
If x > temp2 Then
If st2 = "" Then st2 = temp1(j) Else st2 = st2 & ";" & temp1(j)
x = x - temp2
Else
If st2 = "" Then st2 = Split(temp1(j), "/")(0) & "/" & x Else st2 = st2 & ";" & Split(temp1(j), "/")(0) & "/" & x
brr(i, 3) = st2
Exit For
End If
Next
End If
Next
Sheet1.Range("a2").Resize(UBound(brr), 3) = brr
End Sub

复制代码

yangyangzhifeng · 发表于 2012-7-31 23:54

请看附件

66.rar (8.86 KB, 下载次数: 538)

AVEL · 发表于 2012-8-1 00:14

yangyangzhifeng 发表于 2012-7-31 23:54
请看附件

如果再有一个名称为123 数量为40的试试

yangyangzhifeng · 发表于 2012-8-1 00:39

本帖最后由 yangyangzhifeng 于 2012-8-1 08:10 编辑

AVEL 发表于 2012-8-1 00:14
如果再有一个名称为123 数量为40的试试

考虑不周，没有考虑重复商品，修改如下

Sub test()
Dim arr, i&, d As Object, st1$, st2$
Dim brr, x&, j&, temp1, temp2&
Set d = CreateObject("scripting.dictionary")
Sheet2.Range("a1").CurrentRegion.Sort key1:="商品名称", order1:=xlAscending, key2:="入库时间", order2:=xlAscending, header:=xlYes
arr = Sheet2.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
st1 = arr(i, 1)
st2 = arr(i, 2) & "/" & arr(i, 3)
If Not d.exists(st1) Then
d(st1) = st2
Else
d(st1) = d(st1) & "|" & st2
End If
Next
brr = Sheet1.Range("A2", "c" & Sheet1.Range("a65536").End(xlUp).Row)
For i = 1 To UBound(brr)
st1 = brr(i, 1)
st2 = ""
If d.exists(st1) Then
x = brr(i, 2)
temp1 = Split(d(st1), "|")
For j = 0 To UBound(temp1)
temp2 = Split(temp1(j), "/")(1)
If x > temp2 Then
If st2 = "" Then st2 = temp1(j) Else st2 = st2 & ";" & temp1(j)
If j = UBound(temp1) Then MsgBox "商品" & st1 & "-库存不够": brr(i, 3) = st2
d(st1) = Replace(d(st1), temp1(j) & "|", "", , 1)
x = x - temp2
Else
If st2 = "" Then st2 = Split(temp1(j), "/")(0) & "/" & x Else st2 = st2 & ";" & Split(temp1(j), "/")(0) & "/" & x
d(st1) = Replace(d(st1), temp1(j), Split(temp1(j), "/")(0) & "/" & temp2 - x, , 1)
brr(i, 3) = st2
Exit For
End If
Next
End If
Next
Sheet1.Range("a2").Resize(UBound(brr), 3) = brr
End Sub

复制代码

搁[浅灬 · 发表于 2012-8-1 08:57

yangyangzhifeng 发表于 2012-8-1 00:39
考虑不周，没有考虑重复商品，修改如下

问题解决，各位大大太强了

搁[浅灬 · 发表于 2012-8-6 15:05

yangyangzhifeng 发表于 2012-8-1 00:39
考虑不周，没有考虑重复商品，修改如下

嗯，可以了，那现在我想把各仓位出库的做一个详单，就如同表格3，怎么直接生成，谢谢了{:soso_e100:}

66.rar (10.58 KB, 下载次数: 375)

yangyangzhifeng · 发表于 2012-8-6 23:01

搁[浅灬发表于 2012-8-6 15:05
嗯，可以了，那现在我想把各仓位出库的做一个详单，就如同表格3，怎么直接生成，谢谢了

Sub test()
Dim arr, i&, d As Object, st1$, st2$
Dim brr, x&, j&, temp1, crr
Set d = CreateObject("scripting.dictionary")
Sheet2.Range("a1").CurrentRegion.Sort key1:="商品名称", order1:=xlAscending, key2:="入库时间", order2:=xlAscending, header:=xlYes
arr = Sheet2.Range("a1").CurrentRegion
For i = 2 To UBound(arr)
st1 = arr(i, 1)
st2 = i
If Not d.exists(st1) Then
d(st1) = st2
Else
d(st1) = d(st1) & "|" & st2
End If
Next
brr = Sheet1.Range("A2", "c" & Sheet1.Range("a65536").End(xlUp).Row)
ReDim crr(1 To UBound(arr) + UBound(brr), 1 To 3)
crr(1, 1) = "商品名称": crr(1, 2) = "仓库": crr(1, 3) = "出货数量"
y = 1
For i = 1 To UBound(brr)
st1 = brr(i, 1)
st2 = ""
If d.exists(st1) Then
x = brr(i, 2)
temp1 = Split(d(st1), "|")
For j = 0 To UBound(temp1)
If x > arr(temp1(j), 3) Then
If st2 = "" Then st2 = arr(temp1(j), 2) & "/" & arr(temp1(j), 3) Else st2 = st2 & ";" & arr(temp1(j), 2) & "/" & arr(temp1(j), 3)
If j = UBound(temp1) Then MsgBox "商品" & st1 & "-库存不够": brr(i, 3) = st2
d(st1) = Replace(d(st1), temp1(j) & "|", "", , 1)
x = x - arr(temp1(j), 3)
y = y + 1
crr(y, 1) = arr(temp1(j), 1): crr(y, 2) = arr(temp1(j), 2): crr(y, 3) = arr(temp1(j), 3)
arr(temp1(j), 1) = "": arr(temp1(j), 2) = "": arr(temp1(j), 3) = "": arr(temp1(j), 4) = ""
Else
If st2 = "" Then st2 = arr(temp1(j), 2) & "/" & x Else st2 = st2 & ";" & arr(temp1(j), 2) & "/" & x
brr(i, 3) = st2
arr(temp1(j), 3) = arr(temp1(j), 3) - x
y = y + 1
crr(y, 1) = arr(temp1(j), 1): crr(y, 2) = arr(temp1(j), 2): crr(y, 3) = x
If arr(temp1(j), 3) = 0 Then arr(temp1(j), 1) = "": arr(temp1(j), 2) = "": arr(temp1(j), 3) = "": arr(temp1(j), 4) = ""
Exit For
End If
Next
End If
Next
Sheet1.Range("a2").Resize(UBound(brr), 3) = brr
Sheet2.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
Sheet2.Range("a1").Resize(UBound(arr), UBound(arr, 2)).Sort key1:="商品名称", order1:=xlAscending, key2:="入库时间", order2:=xlAscending, header:=xlYes
Sheet3.Cells.ClearContents: Sheet3.Range("a1").Resize(y, 3) = crr
End Sub

复制代码

66.rar (9.35 KB, 下载次数: 820)

搁[浅灬 · 发表于 2012-8-8 17:58

yangyangzhifeng 发表于 2012-8-6 23:01

谢谢，因为我们使用的是勤哲，需要的是表格1写入商品名称，表格2通过表间公式自动提取库存，再通过宏排仓位后，把仓位的出货数量提取到表格3，再利用表间公式减去表格3，从而达到减去库存，所以表格2不能消去，所以各位大大再帮帮忙（如果你有更好思路欢迎说出，主要排拍仓位再自动减库存，太难了）谢谢啦

yangyangzhifeng · 发表于 2012-8-8 19:31

搁[浅灬发表于 2012-8-8 17:58
谢谢，因为我们使用的是勤哲，需要的是表格1写入商品名称，表格2通过表间公式自动提取库存，再通过宏排仓 ...

以上附件已经自动更新了库存，不知要什么效果？

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

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

评分

评分