如何根据原始表和模板生成目标表12

yzyyyyyyy

原始表关键列：序号，姓名 如何根据原始表和模板生成目标表12.rar (23.65 KB, 下载次数: 23)

2019-10-15 14:34 上传

点击文件名下载附件

模板：封皮1，封皮2
目标表1：根据原始表关键列序号，姓名，和模板封皮1，生成目标表1，每页间加分页符。保持模板的页面设置和行间距和列距
目标表2：根据原始表关键列序号，姓名，和模板封皮2，生成目标表2，每页间加分页符。保持模板的页面设置和行间距和列距

chxw68

1. Sub test1()
   
2.   Dim r%, i%
   
3.   Dim arr, brr, hg(1 To 5) As Double
   
4.   Application.ScreenUpdating = False
   
5.   Application.DisplayAlerts = False
   
6.   With Worksheets("原始表")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:e" & r)
   
9.     For i = 1 To 5
   
10.       hg(i) = .Rows(i).RowHeight
    
11.     Next
    
12.   End With
    
13.   With Worksheets("封皮1")
    
14.     .Cells.PageBreak = xlPageBreakNone
    
15.     m = 5
    
16.     n = 1
    
17.     k = 35
    
18.     .Range("a5:i34").ClearContents
    
19.     For i = 1 To UBound(arr)
    
20.       .Cells(m, n) = arr(i, 1)
    
21.       .Cells(m, n + 1) = arr(i, 3)
    
22.       .Cells(m, n + 2) = arr(i, 5)
    
23.       m = m + 1
    
24.       If m > 34 Then
    
25.         m = 5
    
26.         n = n + 3
    
27.       End If
    
28.       If i = UBound(arr) Or n > 7 Then
    
29.         .Range("a1:i34").Copy .Cells(k, 1)
    
30.         .Range("a5:i34").ClearContents
    
31.         .HPageBreaks.Add Before:=.Rows(k)
    
32.         m = 5
    
33.         n = 1
    
34.         k = k + 34
    
35.       End If
    
36.     Next
    
37.     For i = 1 To k Step 34
    
38.       For j = 1 To UBound(hg) - 1
    
39.         .Rows(i + j - 1).RowHeight = hg(j)
    
40.       Next
    
41.       .Rows(i + 4).Resize(34).RowHeight = hg(5)
    
42.     Next
    
43.     .Range("a1:i34").Delete shift:=xlUp
    
44.   End With
    
45. End Sub
    
46. 
    

复制代码

chxw68

详见附件。

yzyyyyyyy

chxw68 发表于 2019-10-16 08:33
详见附件。

感谢大师热心帮助，解决了一大难题。现需要横向排列，如目标表34样式，麻烦大师有时间看一下，谢谢。经chxw68大师指点，已完成 如何根据原始表和模板生成目标表34.rar (69.86 KB, 下载次数: 5)

2019-10-24 15:53 上传

点击文件名下载附件

1. Sub test3()
   
2.   Dim r%, i%
   
3.   Dim arr, brr, hg(1 To 5) As Double
   
4.   Application.ScreenUpdating = False
   
5.   Application.DisplayAlerts = False
   
6.   With Worksheets("原始表")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:e" & r)
   
9.   End With
   
10.   With Worksheets("封皮3")
    
11.       For i = 1 To 5
    
12.       hg(i) = .Rows(i).RowHeight
    
13.     Next
    
14. 
    
15.     .Cells.PageBreak = xlPageBreakNone
    
16.     m = 5
    
17.     n = 1
    
18.     k = 35
    
19.     .Range("a5:i34").ClearContents
    
20.     For i = 1 To UBound(arr)
    
21.       .Cells(m, n) = arr(i, 1)
    
22.       .Cells(m, n + 1) = arr(i, 3)
    
23.       .Cells(m, n + 2) = arr(i, 5)
    
24.       'm = m + 1
    
25.       n = n + 3
    
26.       If n > 7 Then
    
27.        n = 1
    
28.         m = m + 1
    
29.       End If
    
30.       If i = UBound(arr) Or m > 34 Then
    
31.         .Range("a1:i34").Copy .Cells(k, 1)
    
32.         .Range("a5:i34").ClearContents
    
33.         .HPageBreaks.Add Before:=.Rows(k)
    
34.         m = 5
    
35.         n = 1
    
36.         k = k + 34
    
37.       End If
    
38.     Next
    
39.     For i = 1 To k Step 34
    
40.       For j = 1 To UBound(hg) - 1
    
41.         .Rows(i + j - 1).RowHeight = hg(j)
    
42.       Next
    
43.       .Rows(i + 4).Resize(34).RowHeight = hg(5)
    
44.     Next
    
45.     .Range("a1:i34").Delete shift:=xlUp
    
46.             .HPageBreaks.Add Before:=.Rows(35)
    
47.   End With
    
48. End Sub
    
49. 
    
50. 
    
51. Sub test4()
    
52.   Dim r%, i%
    
53.   Dim arr, brr, hg(1 To 5) As Double
    
54.   Application.ScreenUpdating = False
    
55.   Application.DisplayAlerts = False
    
56.   With Worksheets("原始表")
    
57.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
58.     arr = .Range("a2:e" & r)
    
59. 
    
60.   End With
    
61.   With Worksheets("封皮4")
    
62.       For i = 1 To 5
    
63.       hg(i) = .Rows(i).RowHeight
    
64.     Next
    
65.     .Cells.PageBreak = xlPageBreakNone
    
66.     m = 5
    
67.     n = 1
    
68.     k = 20
    
69.     .Range("a5:f19").ClearContents
    
70.     For i = 1 To UBound(arr)
    
71.       .Cells(m, n) = arr(i, 1)
    
72.       .Cells(m, n + 1) = arr(i, 3)
    
73.       .Cells(m, n + 2) = arr(i, 5)
    
74.       n = n + 3
    
75.       If n > 4 Then
    
76.         n = 1
    
77.         m = m + 1
    
78.       End If
    
79.       If i = UBound(arr) Or m > 19 Then
    
80.         .Range("a1:f19").Copy .Cells(k, 1)
    
81.         .Range("a5:f19").ClearContents
    
82.         .HPageBreaks.Add Before:=.Rows(k)
    
83.         m = 5
    
84.         n = 1
    
85.         k = k + 19
    
86.       End If
    
87.     Next
    
88.     For i = 1 To k Step 19
    
89.       For j = 1 To UBound(hg) - 1
    
90.         .Rows(i + j - 1).RowHeight = hg(j)
    
91.       Next
    
92.       .Rows(i + 4).Resize(15).RowHeight = hg(5)
    
93.     Next
    
94.     .Range("a1:f19").Delete shift:=xlUp
    
95.                 .HPageBreaks.Add Before:=.Rows(20)
    
96.   End With
    
97. End Sub
    
98. 
    
99. 
    
100. 
     
101. 
     
102. 
     

复制代码