[已解决]如何快速的打印出销售单

451991574

由于数量较多，急着一次性要打印3000多张，有没有什么方法能够不用一直点销售单号就能一次性打出几百张出来呢

最佳答案

月排行榜 / 总排行榜

心正意诚身修

2021-10-25 22:59

1. Sub 打印清单()
   
2. Dim ARR, BRR(), D, MAXROW, STARTROW, ENDROW, I As Long, J As Long, K, L As Byte, M, N
   
3. MAXROW = Sheets("销售明细").Range("A65536").End(xlUp).Row
   
4. ARR = Sheets("销售明细").Range("A3:Q" & MAXROW)
   
5. ReDim BRR(1 To 12, 1 To 10)
   
6. J = 1
   
7. Set D = CreateObject("SCRIPTING.DICTIONARY")
   
8. For I = 1 To UBound(ARR)
   
9.    If Not D.EXISTS(ARR(I, 1)) Then
   
10.       D(ARR(I, 1)) = J
    
11.       J = J + 1
    
12.    Else
    
13.    End If
    
14. Next
    
15. Range("D3").ClearContents
    
16. Range("H3").ClearContents
    
17. Range("K3").ClearContents
    
18. Range("C5:L16").ClearContents
    
19. For Each K In D.KEYS
    
20.    Range("H3").Value = K
    
21.    M = Application.Match(K, Sheets("销售明细").Range("A3:A" & MAXROW), 0)
    
22.    Range("D3").Value = ARR(M, 4)
    
23.    Range("K3").Value = ARR(M, 6)
    
24.    For L = 1 To Application.CountIf(Sheets("销售明细").Range("A3:A" & MAXROW), K)
    
25.        BRR(L, 1) = ARR(M - 1 + L, 7)
    
26.        BRR(L, 2) = ARR(M - 1 + L, 10)
    
27.        BRR(L, 3) = ARR(M - 1 + L, 8)
    
28.        BRR(L, 4) = ARR(M - 1 + L, 9)
    
29.        BRR(L, 5) = ARR(M - 1 + L, 11)
    
30.        BRR(L, 6) = ARR(M - 1 + L, 12)
    
31.        BRR(L, 7) = ARR(M - 1 + L, 13)
    
32.        BRR(L, 8) = ARR(M - 1 + L, 14)
    
33.        BRR(L, 9) = ARR(M - 1 + L, 16)
    
34.        BRR(L, 10) = ARR(M - 1 + L, 17)
    
35.    Next L
    
36.    Range("C5").Resize(12, 10) = BRR
    
37.    ActiveSheet.PrintOut
    
38.    Range("D3").ClearContents
    
39.    Range("H3").ClearContents
    
40.    Range("K3").ClearContents
    
41.    Range("C5:L16").ClearContents
    
42.    Erase BRR()
    
43.    ReDim BRR(1 To 12, 1 To 10)
    
44. Next
    
45. MsgBox "已分类并打印完成"
    
46. End Sub
    

复制代码

一个多月过去了。估计你都忘记这个了。一个很好的练习题。家里电脑没有打印机。测试了一下，应该是满足你的要求的。

跳转到最佳答案楼层

aidunsoft

用vlookup函数填充订单不是一个好办法，如果数据量大，电脑又不好，打开一个订单表会很卡，如果用艾敦制表神器的邮件合并功能就比较好， 一次可批量生成订单表，一次性打印


销售单.zip (71.15 KB, 下载次数: 1)

2021-10-24 22:49 上传

点击文件名下载附件

songxueyi1

word里面不是有个邮件功能么

心正意诚身修

1. Sub 打印清单()
   
2. Dim ARR, BRR(), D, MAXROW, STARTROW, ENDROW, I As Long, J As Long, K, L As Byte, M, N
   
3. MAXROW = Sheets("销售明细").Range("A65536").End(xlUp).Row
   
4. ARR = Sheets("销售明细").Range("A3:Q" & MAXROW)
   
5. ReDim BRR(1 To 12, 1 To 10)
   
6. J = 1
   
7. Set D = CreateObject("SCRIPTING.DICTIONARY")
   
8. For I = 1 To UBound(ARR)
   
9.    If Not D.EXISTS(ARR(I, 1)) Then
   
10.       D(ARR(I, 1)) = J
    
11.       J = J + 1
    
12.    Else
    
13.    End If
    
14. Next
    
15. Range("D3").ClearContents
    
16. Range("H3").ClearContents
    
17. Range("K3").ClearContents
    
18. Range("C5:L16").ClearContents
    
19. For Each K In D.KEYS
    
20.    Range("H3").Value = K
    
21.    M = Application.Match(K, Sheets("销售明细").Range("A3:A" & MAXROW), 0)
    
22.    Range("D3").Value = ARR(M, 4)
    
23.    Range("K3").Value = ARR(M, 6)
    
24.    For L = 1 To Application.CountIf(Sheets("销售明细").Range("A3:A" & MAXROW), K)
    
25.        BRR(L, 1) = ARR(M - 1 + L, 7)
    
26.        BRR(L, 2) = ARR(M - 1 + L, 10)
    
27.        BRR(L, 3) = ARR(M - 1 + L, 8)
    
28.        BRR(L, 4) = ARR(M - 1 + L, 9)
    
29.        BRR(L, 5) = ARR(M - 1 + L, 11)
    
30.        BRR(L, 6) = ARR(M - 1 + L, 12)
    
31.        BRR(L, 7) = ARR(M - 1 + L, 13)
    
32.        BRR(L, 8) = ARR(M - 1 + L, 14)
    
33.        BRR(L, 9) = ARR(M - 1 + L, 16)
    
34.        BRR(L, 10) = ARR(M - 1 + L, 17)
    
35.    Next L
    
36.    Range("C5").Resize(12, 10) = BRR
    
37.    ActiveSheet.PrintOut
    
38.    Range("D3").ClearContents
    
39.    Range("H3").ClearContents
    
40.    Range("K3").ClearContents
    
41.    Range("C5:L16").ClearContents
    
42.    Erase BRR()
    
43.    ReDim BRR(1 To 12, 1 To 10)
    
44. Next
    
45. MsgBox "已分类并打印完成"
    
46. End Sub
    

复制代码

一个多月过去了。估计你都忘记这个了。一个很好的练习题。家里电脑没有打印机。测试了一下，应该是满足你的要求的。

心正意诚身修

1. Sub 打印清单()
   
2. Dim ARR, BRR(), D, MAXROW, STARTROW, ENDROW, I As Long, J As Long, K, L As Byte, M, N
   
3. MAXROW = Sheets("销售明细").Range("A65536").End(xlUp).Row
   
4. ARR = Sheets("销售明细").Range("A3:Q" & MAXROW)
   
5. ReDim BRR(1 To 12, 1 To 10)
   
6. J = 1
   
7. Set D = CreateObject("SCRIPTING.DICTIONARY")
   
8. For I = 1 To UBound(ARR)
   
9.    If Not D.EXISTS(ARR(I, 1)) Then
   
10.       D(ARR(I, 1)) = J
    
11.       End If
    
12. Next
    
13. Range("C5:L16").ClearContents
    
14. For Each K In D.KEYS
    
15.    Range("H3").Value = K
    
16.    M = Application.Match(K, Sheets("销售明细").Range("A3:A" & MAXROW), 0)
    
17.    Range("D3").Value = ARR(M, 4)
    
18.    Range("K3").Value = ARR(M, 6)
    
19.    For L = 1 To Application.CountIf(Sheets("销售明细").Range("A3:A" & MAXROW), K)
    
20.        BRR(L, 1) = ARR(M - 1 + L, 7)
    
21.        BRR(L, 2) = ARR(M - 1 + L, 10)
    
22.        BRR(L, 3) = ARR(M - 1 + L, 8)
    
23.        BRR(L, 4) = ARR(M - 1 + L, 9)
    
24.        BRR(L, 5) = ARR(M - 1 + L, 11)
    
25.        BRR(L, 6) = ARR(M - 1 + L, 12)
    
26.        BRR(L, 7) = ARR(M - 1 + L, 13)
    
27.        BRR(L, 8) = ARR(M - 1 + L, 14)
    
28.        BRR(L, 9) = ARR(M - 1 + L, 16)
    
29.        BRR(L, 10) = ARR(M - 1 + L, 17)
    
30.    Next L
    
31.    Range("C5").Resize(12, 10) = BRR
    
32.    ActiveSheet.PrintOut
    
33.    Range("C5:L16").ClearContents
    
34.    ReDim BRR(1 To 12, 1 To 10)
    
35. Next
    
36. End Sub
    

复制代码

简化了一下