根据导数自动生成进仓单和出仓单

jxiao108

因为系统更换了导出来的格式，请教各位大神：根据导数自动生成进仓单和出仓单，日期，客户名称，产品名称，数量和金额自动填在后面的仓单里面，编号自动按 年+月+001 这样的格式生成，比如1月第一张凭证编号就是201901001,  2月第三张编号就是 201902003。麻烦各位大神指导

jxiao108

朱版主，麻烦指导一下，导数就是前面第一个表上面的数

一指禅62

进仓用科目代码 1243（库存商品）、出仓用科目代码5101（主营业务收入）判断是否正确？

jxiao108

可以的，@一指禅62 ，后面有3张出仓单和进仓单都是根据前面表格的数据提取出来的，麻烦指教

一指禅62

jxiao108 发表于 2019-3-18 15:10
可以的，@一指禅62 ，后面有3张出仓单和进仓单都是根据前面表格的数据提取出来的，麻烦指教

控制性代码

1. Private Sub 生成记账单(key As String)
   
2.     Dim arr, i&, s$, d As Object
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Rem 收集进（出）仓信息
   
5.     arr = Sheet1.Range("A1").CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         If arr(i, 7) = IIf(key = "进", "1243", "5101") Then
   
8.             s = Format(arr(i, 1), "yyyymm") & Format(arr(i, 3), "0000")
   
9.             If Not d.Exists(s) Then
   
10.                 d(s) = i
    
11.             Else
    
12.                 d.Item(s) = d.Item(s) & "|" & i
    
13.             End If
    
14.         End If
    
15.     Next
    
16.     Rem 逐号制作进（出）仓单
    
17.     Dim k, t, N%, R&
    
18.     Application.ScreenUpdating = False
    
19.     Range("A17:F65536").Delete Shift:=xlUp
    
20.     For Each k In d.keys
    
21.         N = N + 1
    
22.         R = 5
    
23.         Range("A5:F13") = ""
    
24.         Range("A2") = arr(t, 1)
    
25.         Range("F2") = Mid(k, 1, 6) & Format(N, "000")
    
26.         Range("A3") = Split(arr(t, 6), " ")(0)
    
27.         For Each t In Split(d.Item(k), "|")
    
28.             Range("A" & R) = Replace(arr(t, 8), IIf(key = "进", "库存商品_", "主营业务收入_"), "")
    
29.             Range("B" & R) = ""
    
30.             Range("C" & R) = "吨"
    
31.             Range("D" & R) = arr(t, 20)
    
32.             Range("E" & R) = arr(t, 21)
    
33.             Range("F" & R) = arr(t, 22)
    
34.             R = R + 1
    
35.         Next
    
36.         Range("A1:F16").Copy
    
37.         Range("A65536").End(3).Offset(3, 0).PasteSpecial
    
38.     Next
    
39.     If N > 1 Then Range("A1:F18").Delete Shift:=xlUp
    
40.     Application.ScreenUpdating = True
    
41. End Sub

复制代码

一指禅62

jxiao108 发表于 2019-3-18 15:10
可以的，@一指禅62 ，后面有3张出仓单和进仓单都是根据前面表格的数据提取出来的，麻烦指教

序列帐新格式.rar (35.22 KB, 下载次数: 80)

2019-3-18 16:51 上传

点击文件名下载附件

1. Sub 生成进仓单()
   
2.     Sheet3.Select
   
3.     Call 生成记账单("进")
   
4. End Sub
   
5. 
   
6. Sub 生成出仓单()
   
7.     Sheet2.Select
   
8.     Call 生成记账单("出")
   
9. End Sub

复制代码

micch

学习了，老师的代码好清晰

一指禅62

jxiao108 发表于 2019-3-18 15:10
可以的，@一指禅62 ，后面有3张出仓单和进仓单都是根据前面表格的数据提取出来的，麻烦指教

看了楼主的空间，发现该问题重复发帖，有点浪费大家的时间啊

http://club.excelhome.net/home.php?mod=space&uid=1177385

一指禅62

micch 发表于 2019-3-18 17:06
学习了，老师的代码好清晰

谢谢！共同学习！