[已解决]根据销售清单自动生成出库单，一个出库单号生成一张出库单，并能连续打印

无聊猫1112

求助大神：

1、根据销售清单自动生成出库单，一个出库单号生成一张出库单，并能连续打印
2、出库单格式行数固定，最后一行和销售金额合计，清单的表头对应出库单的名称
3、一张A4纸打印两张
销售清单自动生成出库单.zip (104.44 KB, 下载次数: 74)

2016-4-6 13:43 上传

点击文件名下载附件
1

最佳答案

月排行榜 / 总排行榜

sry660

2016-4-6 14:13

1. Sub 出库单打印()
   
2.     Dim arr, i&, j&, x, d, brr, n, kh, dh
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets(1).[a1].CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         x = arr(i, 1): d(x) = ""
   
7.     Next
   
8.     For Each x In d.keys
   
9.         ReDim brr(1 To UBound(arr), 1 To 7)
   
10.         For i = 2 To UBound(arr)
    
11.             If arr(i, 1) = x Then
    
12.                 kh = arr(i, 4): dh = x  'kh为客户名称，dh为单号
    
13.                 n = n + 1
    
14.                 brr(n, 1) = arr(i, 2): brr(n, 2) = arr(i, 3)
    
15.                 For j = 3 To 7
    
16.                     brr(n, j) = arr(i, j + 2)
    
17.                 Next
    
18.             End If
    
19.         Next
    
20.         With Sheets(2)
    
21.             .[a5:g13].ClearContents
    
22.             .[b3] = kh: .[g3] = dh
    
23.             .[a5].Resize(n, 7) = brr
    
24.             .[a2:g15].PrintPreview
    
25.             '.[a2:g15].PrintOut
    
26.         End With
    
27.         Erase brr
    
28.         n = 0
    
29.     Next
    
30. End Sub

复制代码

跳转到最佳答案楼层

sry660

1. Sub 出库单打印()
   
2.     Dim arr, i&, j&, x, d, brr, n, kh, dh
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets(1).[a1].CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         x = arr(i, 1): d(x) = ""
   
7.     Next
   
8.     For Each x In d.keys
   
9.         ReDim brr(1 To UBound(arr), 1 To 7)
   
10.         For i = 2 To UBound(arr)
    
11.             If arr(i, 1) = x Then
    
12.                 kh = arr(i, 4): dh = x  'kh为客户名称，dh为单号
    
13.                 n = n + 1
    
14.                 brr(n, 1) = arr(i, 2): brr(n, 2) = arr(i, 3)
    
15.                 For j = 3 To 7
    
16.                     brr(n, j) = arr(i, j + 2)
    
17.                 Next
    
18.             End If
    
19.         Next
    
20.         With Sheets(2)
    
21.             .[a5:g13].ClearContents
    
22.             .[b3] = kh: .[g3] = dh
    
23.             .[a5].Resize(n, 7) = brr
    
24.             .[a2:g15].PrintPreview
    
25.             '.[a2:g15].PrintOut
    
26.         End With
    
27.         Erase brr
    
28.         n = 0
    
29.     Next
    
30. End Sub

复制代码

无聊猫1112

sry660 发表于 2016-4-6 14:13

十分感谢，很好用，请问老师，能不能生成两张出库单在同一张纸上，现在是一张出库单一张纸有点浪费。