EXCEL表格如何自动批量生成单据形式

0602689zml

EXCEL如何将表2自动批量生成表1的单据形式,EXCEL自身可以实现吗？不行的话，用VBA是否可实现

windyjw007

单击生成结果！{:2012:}

1. Sub test()
   
2.     Dim ar, br
   
3.     Dim i As Long, j As Long
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     On Error Resume Next
   
7.     Sheets("结果").Delete
   
8.     On Error GoTo 0
   
9.     Sheets("模板").Copy , Sheets(Sheets.Count)
   
10.     ActiveSheet.Name = "结果"
    
11.     ar = Sheets("表2").Cells(1, 1).CurrentRegion
    
12.     For i = 2 To UBound(ar)
    
13.         j = i * 19 - 18
    
14.         Range("A1:I16").Copy Cells(j, 1)
    
15.         Cells(j, 7) = ar(i, 6)
    
16.         Cells(j + 1, 2) = ar(i, 1)
    
17.         Cells(j + 4, 2) = ar(i, 7)
    
18.         Cells(j + 4, 4) = ar(i, 8)
    
19.         Cells(j + 4, 6) = ar(i, 3) & ar(i, 4) & "件"
    
20.         Cells(j + 8, 2) = ar(i, 5)
    
21.         Cells(j + 10, 2) = ar(i, 2)
    
22.     Next i
    
23.     Rows("1:19").Delete
    
24.     Application.DisplayAlerts = True
    
25.     Application.ScreenUpdating = True
    
26. End Sub
    

复制代码

0602689zml

太感谢了。太好用了。如果要实现每个单据自动打印在一张纸上的话，可以实现吗？

windyjw007

0602689zml 发表于 2017-10-23 11:19
太感谢了。太好用了。如果要实现每个单据自动打印在一张纸上的话，可以实现吗？

再试试！以后有问题请回复我，不然没有提醒哈。。。{:1012:}

1. Sub test()
   
2.     Dim ar, br
   
3.     Dim i As Long, j As Long
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     On Error Resume Next
   
7.     Sheets("结果").Delete
   
8.     On Error GoTo 0
   
9.     Sheets("模板").Copy , Sheets(Sheets.Count)
   
10.     ActiveSheet.Name = "结果"
    
11.     ar = Sheets("表2").Cells(1, 1).CurrentRegion
    
12.     For i = 2 To UBound(ar)
    
13.         j = i * 19 - 18
    
14.         Range("A1:I16").Copy Cells(j, 1)
    
15.         Cells(j, 7) = ar(i, 6)
    
16.         Cells(j + 1, 2) = ar(i, 1)
    
17.         Cells(j + 4, 2) = ar(i, 7)
    
18.         Cells(j + 4, 4) = ar(i, 8)
    
19.         Cells(j + 4, 6) = ar(i, 3) & ar(i, 4) & "件"
    
20.         Cells(j + 8, 2) = ar(i, 5)
    
21.         Cells(j + 10, 2) = ar(i, 2)
    
22.         ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(j, 1)
    
23.     Next i
    
24.     Rows("1:19").Delete
    
25.     ActiveSheet.PageSetup.PrintArea = "$A$1:$I$" & j - 1
    
26.     Application.DisplayAlerts = True
    
27.     Application.ScreenUpdating = True
    
28. End Sub
    

复制代码