请求老师帮忙办连续打印模板改成两列打印。谢谢

108079955

求哪位老师帮忙看看这个怎么修改一下  ，
          把这个根据模板连续打印的成一列的代码修改成为两列的样式。单列打印代码运行时正常的。

  在此先谢谢老师了！

3190496160

找原作者帮你解决呗，别人要看懂代码再来修改，还不如自己写代码来的快

108079955

3190496160 发表于 2023-5-4 16:17
找原作者帮你解决呗，别人要看懂代码再来修改，还不如自己写代码来的快

呵呵  大侠老师   说的没错   论坛里的都找不到原作者是谁呀      对我来说是天书   对你来说……   我以前看过一个 就像向下平移一下  向左也用了一个变量 可以随便平移几个变量都可以的    现在找不到了呀   

108079955

108079955 发表于 2023-5-4 16:37
呵呵  大侠老师   说的没错   论坛里的都找不到原作者是谁呀      对我来说是天书   对你来说……   我以 ...

我们外行觉得 让老师写的话   比较费时间   修改一起比较容易呀   呵呵

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim hg(), lk()
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     With Worksheets("数据")
   
8.         r = .Cells(.Rows.Count, 3).End(xlUp).Row
   
9.         arr = .Range("a2:i" & r)
   
10.     End With
    
11.     With Worksheets("打印")
    
12.         .Cells.Clear
    
13.     End With
    
14.     m = 1
    
15.     n = 1
    
16.     With Worksheets("模板")
    
17.         ReDim hg(1 To 14)
    
18.         ReDim lk(1 To 12)
    
19.         For i = 1 To 14
    
20.             hg(i) = .Rows(i).RowHeight
    
21.         Next
    
22.         For j = 1 To 12
    
23.             lk(j) = .Columns(j).ColumnWidth
    
24.         Next
    
25.         For i = 1 To UBound(arr)
    
26.             .Range("c4") = arr(i, 4)
    
27.             .Range("c6") = arr(i, 6)
    
28.             .Range("c8") = arr(i, 3)
    
29.             .Range("c10") = arr(i, 5)
    
30.             .Range("j3") = arr(i, 7)
    
31.             .Range("k3") = arr(i, 8)
    
32.             .Range("l3") = arr(i, 9)
    
33.             .Range("a1:l14").Copy Worksheets("打印").Cells(m, n)
    
34.             If i Mod 2 = 1 Then
    
35.                 For k = 1 To 14
    
36.                     .Rows(m + k - 1).RowHeight = hg(k)
    
37.                 Next
    
38.             End If
    
39.             n = n + 14
    
40.             If n > 15 Then
    
41.                 n = 1
    
42.                 m = m + 14
    
43.             End If
    
44.         Next
    
45.     End With
    
46.     With Worksheets("打印")
    
47.         For j = 1 To 12
    
48.             .Columns(j).ColumnWidth = lk(j)
    
49.             .Columns(j + 15).ColumnWidth = lk(j)
    
50.         Next
    
51.         
    
52.     End With
    
53. End Sub
    

复制代码

chxw68

重新写了一个，供参考。

gwjkkkkk

参与一下。。。

108079955

chxw68 发表于 2023-5-4 17:04

非常感谢chxw68老师无私的辛苦付出。代码非常好用，正式我想要的样子。再次感谢老师！！！

108079955

gwjkkkkk 发表于 2023-5-4 19:37
参与一下。。。

gwjkkkkk老师，非常谢谢你的辛苦付出。用起来很好的。数组看起来很简洁，就是外行的小白看不太理解的还需努力学习了。再次感谢老师！！！