ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > 行业案例 > 市场营销 > 一个销售出库单样本，给需要的人

一个销售出库单样本，给需要的人

作者：绿色风 分类：市场营销 时间：2022-08-18 浏览：179
楼主
kevinchengcw		 根据本社区一个帖子提出的问题写出的一个出库单自动生成样本，相信很多有同样需要的人，拿出来与大家一起分享，见附件

共分成三部来完成：
一：提取客户信息存入“客户资料”工作表
二：生成出库汇总（出库货品清单，出库单号及合格证号）
三：生成要打印的出库单表格

全部代码如下：
  1. Private Sub CommandButton1_Click()
  2. Dim Arr, Arr1, Arr2, Dic
  3. Dim M, N, R, No, I As Integer
  4. Set Dic = CreateObject("scripting.dictionary")
  5. '步骤一：
  6. Arr = Split("b2,e2,g2,B3,e3,G3", ",")  '生成要提取的客户资料于工作单中存放的单元格地址数组
  7. M = Worksheets("客户资料").[a65536].End(3).Row + 1  '取得客户资料中的要写入的行地址
  8. For N = 0 To UBound(Arr)    '循环提取客户资料
  9.     Worksheets("客户资料").Cells(M, N + 1) = Worksheets("工作单").Range(Arr(N))
  10. Next N
  11. '步骤二：
  12. With Worksheets("工作单")
  13.     For N = 5 To .[g65536].End(3).Row    '循环取值，并利用字典去除重复项
  14.         If Not Dic.exists(.Cells(N, 7).Value) Then Dic.Add .Cells(N, 7).Value, .Cells(N, 6).Value
  15.     Next N
  16. End With
  17. I = 1
  18. M = Worksheets("出库汇总").[a65536].End(3).Row + 1   '确定出库汇总中的续写行数起始值
  19. For N = 5 To Worksheets("工作单").[a65536].End(3).Row   '循环写入工作单只对应数据到出库汇总表中
  20.     With Worksheets("工作单")
  21.         Worksheets("出库汇总").Cells(M, 1) = .[b2]
  22.         Worksheets("出库汇总").Cells(M, 2) = .[e2]
  23.         Worksheets("出库汇总").Cells(M, 4) = .Cells(N, 6)
  24.         Worksheets("出库汇总").Cells(M, 5) = .Cells(N, 7)
  25.         If Day(Worksheets("出库汇总").Cells(M - 1, 2)) = Day(Worksheets("出库汇总").Cells(M, 2)) And M > 2 Then
  26.             If Worksheets("出库汇总").Cells(M, 4) = Worksheets("出库汇总").Cells(M - 1, 4) And Worksheets("出库汇总").Cells(M, 5) = Worksheets("出库汇总").Cells(M - 1, 5) Then
  27.                 Worksheets("出库汇总").Cells(M, 3) = Worksheets("出库汇总").Cells(M - 1, 3)
  28.             Else
  29.                 Worksheets("出库汇总").Cells(M, 3) = .[g1] & "-" & Val(Replace(Right(Worksheets("出库汇总").Cells(M - 1, 3), 2), "-", "")) + 1
  30.             End If
  31.         Else
  32.             Worksheets("出库汇总").Cells(M, 3) = .[g1] & "-1"
  33.         End If
  34.         Worksheets("出库汇总").Cells(M, 6) = ""
  35.         Worksheets("出库汇总").Cells(M, 7) = .Cells(N, 1)
  36.         Worksheets("出库汇总").Cells(M, 8) = .Cells(N, 2)
  37.         Worksheets("出库汇总").Cells(M, 9) = .Cells(N, 3)
  38.         Worksheets("出库汇总").Cells(M, 10) = .Cells(N, 4)
  39.         Worksheets("出库汇总").Cells(M, 11) = .Cells(N, 5)
  40.         If Month(Worksheets("出库汇总").Cells(M, 2)) = Month(Worksheets("出库汇总").Cells(M - 1, 2)) Then
  41.             If Worksheets("出库汇总").Cells(M, 9) > 1 Then
  42.                 Worksheets("出库汇总").Cells(M, 12) = Format(Worksheets("出库汇总").Cells(M, 2), "YYYYMM") & Format(Val(Right(Worksheets("出库汇总").Cells(M - 1, 12), 2)) + 1, "00") & "-" & Format(Worksheets("出库汇总").Cells(M, 2), "YYYYMM") & Format(Val(Right(Worksheets("出库汇总").Cells(M - 1, 12), 2)) + Worksheets("出库汇总").Cells(M, 9), "00")
  43.             Else
  44.                 Worksheets("出库汇总").Cells(M, 12) = Format(Worksheets("出库汇总").Cells(M, 2), "YYYYMM") & Format(Val(Right(Worksheets("出库汇总").Cells(M - 1, 12), 2)) + 1, "00")
  45.             End If
  46.         Else
  47.             If Worksheets("出库汇总").Cells(M, 9) > 1 Then
  48.                 Worksheets("出库汇总").Cells(M, 12) = Format(Worksheets("出库汇总").Cells(M, 2), "YYYYMM") & "01-" & Format(Worksheets("出库汇总").Cells(M, 2), "YYYYMM") & Format(Worksheets("出库汇总").Cells(M, 9), "00")
  49.             Else
  50.                 Worksheets("出库汇总").Cells(M, 12) = Format(Worksheets("出库汇总").Cells(M, 2), "YYYYMM") & "01"
  51.             End If
  52.         End If
  53.         M = M + 1
  54.     End With
  55. Next N
  56. '步骤三：
  57. Arr1 = Dic.keys  '生成写入项数组
  58. Arr2 = Split("器具名称,规格,数量,单价,价格,合格证号,其他说明", ",")  '生成标题项数组
  59. R = 1
  60. With Worksheets("出库单")   '删除旧有单据
  61.     .Columns("A:H").Insert shift:=xlToRight
  62.     .Columns("I:P").Delete
  63.     .Columns("A:H").EntireColumn.AutoFit
  64.     '.Columns("A:H").Cells.MergeCells = False
  65. End With
  66. For No = 0 To UBound(Arr1)   '循环生成出库单
  67.     With Worksheets("出库单")
  68.         .Cells(R, 1) = "出库单"
  69.         .Cells(R, 1).Offset(1, 0) = "单位名称"
  70.         .Cells(R, 1).Offset(1, 1) = Worksheets("工作单").Range(Arr(0))
  71.         .Cells(R, 1).Offset(1, 3) = "销售日期"
  72.         .Cells(R, 1).Offset(1, 4) = Worksheets("工作单").Range(Arr(1))
  73.         .Cells(R, 1).Offset(1, 4).NumberFormatLocal = "yyyy-m-d"
  74.         .Cells(R, 1).Offset(1, 5) = "出库单号"
  75.         .Cells(R, 1).Offset(1, 6) = Worksheets("工作单").Range("g1").Value & "-" & No + 1
  76.         .Cells(R, 1).Offset(2, 0) = "所属类别"
  77.         .Cells(R, 1).Offset(2, 1) = Dic.Item(Arr1(No))
  78.         .Cells(R, 1).Offset(2, 3) = "所属项目"
  79.         .Cells(R, 1).Offset(2, 4) = Arr1(No)
  80.         .Cells(R, 1).Offset(2, 5) = "出库日期"
  81.         .Cells(R, 1).Offset(2, 6) = ""
  82.         .Range(.Cells(R, 1).Offset(2, 1), .Cells(R, 1).Offset(2, 2)).MergeCells = True
  83.         .Range(.Cells(R, 1).Offset(1, 1), .Cells(R, 1).Offset(1, 2)).MergeCells = True
  84.         For M = 0 To UBound(Arr2)
  85.             .Cells(R, 1).Offset(3, M) = Arr2(M)
  86.         Next M
  87.         I = 0
  88.         For N = 3 To Worksheets("出库汇总").[a65536].End(3).Row
  89.             If Worksheets("出库汇总").Cells(N, 3) = .Cells(R, 1).Offset(1, 6) Then
  90.                 .Cells(R, 1).Offset(4 + I, 0) = Worksheets("出库汇总").Cells(N, 7)
  91.                 .Cells(R, 1).Offset(4 + I, 1) = Worksheets("出库汇总").Cells(N, 8)
  92.                 .Cells(R, 1).Offset(4 + I, 2) = Worksheets("出库汇总").Cells(N, 9)
  93.                 .Cells(R, 1).Offset(4 + I, 3) = Worksheets("出库汇总").Cells(N, 10)
  94.                 .Cells(R, 1).Offset(4 + I, 4) = Worksheets("出库汇总").Cells(N, 11)
  95.                 .Cells(R, 1).Offset(4 + I, 5) = Worksheets("出库汇总").Cells(N, 12)
  96.                 I = I + 1
  97.             End If
  98.         Next N
  99.         .Range(.Cells(R, 1), .Cells(R, 7)).MergeCells = True   '完成表格及格式设定
  100.         M = .[a65536].End(3).Row
  101.         .Range(.Cells(R, 1), .Cells(M, 7)).Borders.LineStyle =1
  102.         With .Range(.Cells(R, 1), .Cells(M, 7))
  103.             .HorizontalAlignment = xlCenter
  104.             .VerticalAlignment = xlCenter
  105.             .WrapText = False
  106.             .Orientation = 0
  107.             .AddIndent = False
  108.             .IndentLevel = 0
  109.             .ShrinkToFit = False
  110.             .ReadingOrder = xlContext
  111.         End With
  112.         For N = 1 To 7
  113.             .Columns(N).EntireColumn.AutoFit
  114.         Next N
  115.         R = M + 3
  116.      End With
  117. Next No   
  118. End Sub

销售出库单.rar
2楼
kkkdan888		 谢谢分享，顶一下！
3楼
lrlxxqxa		 这个集成功能挺好的
4楼
泉水		 太需要了，狂顶，谢谢分享，在快要失望的时候带来了希望！
5楼
泉水		 测试了一下，还有些小地方需要老师再次指导，测试数据及要求在压缩包内，谢谢！
销售出库单 (1).rar
6楼
wnianzhong		 顶一下！谢谢!
7楼
kejunsuoya		 怎么用啊？
8楼
wanglaoban		 谢谢分享
9楼
howareyou		 顶，好贴！
10楼
润物细无声		 太需要了，谢谢！下来看看
11楼
yardview		 学习学习，再学习
12楼
linjie514191		 急需，先看看。
13楼
cyn629		 语言很强大，下载来看看是怎么实现的，谢谢分享
14楼
111123		 下了，怎么用呢？
15楼
rhr2008		 谢谢楼主分享！学习了！
16楼
hjswxh		 哪位高手指导一下
怎么使用
17楼
haier		 请版主指导一下如何使用
18楼
王方建		 先下来学习，学习。
19楼
战神一啸		 兄弟，销售这一块的原创帖你你发了一份，今后我也要发！
20楼
lysm		 学习学习
21楼
yuyebaixue		 谢谢分享
22楼
希然		 谢谢分享
23楼
火焰		 代码复制后怎么用呀，还望高手指教
24楼
lianyi_2006		 是啊，怎么用呢
25楼
272779357		 谢谢分享
26楼
wsqzwl		 太需要了，谢谢！ 顶，好贴！
27楼
冰心8549		 谢谢分享
28楼
JOYARK1958		 謝謝提供.................................下載學習
29楼
jxcbx		 先下来看看,好好学习研究
30楼
枫火之夜		 这么多人来下载，学习一下！

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap