如何每页打印固定序号行内容

lovespz

想实现按序号1-5打印在第一页，6-10在第二页，依此类推请问如何实现？

3190496160

如果合并单元格的行数一致，还可能用vba来设置，不一致没办法

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     .Cells.PageBreak = xlPageBreakNone
   
6.     r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
   
7.     arr = .Range("a1:a" & r)
   
8.     For i = 4 To UBound(arr)
   
9.       If Len(arr(i, 1)) <> 0 Then
   
10.         If Val(arr(i, 1)) Mod 5 = 1 And Val(arr(i, 1)) <> 1 Then
    
11.           .HPageBreaks.Add Before:=.Rows(i)
    
12.         End If
    
13.       End If
    
14.     Next
    
15.   End With
    
16. End Sub
    

复制代码

chxw68

在指定位置插入分页符就行了。

lovespz

chxw68 发表于 2020-2-19 21:42
在指定位置插入分页符就行了。

非常感谢楼上大佬出手相助，实现了想要的功能。
另外请问一下，可以固定备注的一行文字在每页的底部吗？（不用页脚功能）

gbgbxgb

楼主臭蛋一枚，求助附件的小组成员列等数据源还要写码者自行补足，这是求助的态度吗？!!!!
愤怒!

试试附件。
每5个序号打印一页纸.rar (17.91 KB, 下载次数: 7)

2020-2-19 23:12 上传

点击文件名下载附件

SCL5801

Sub shet()
   Dim i&, n%, m, x%
   ActiveSheet.ResetAllPageBreaks
   For i = 4 To Range("a1000").End(3).Row
      If Not Range("a" & i).MergeCells Then
         n = n + 1
      End If
      If Range("a" & i).MergeCells Then
         n = n + 1
         ad = Range("A" & i).MergeArea.Address(1, 0)
         bb = Split(ad, ":")
         m = Val(Split(bb(1), "$")(1))
         i = m
      End If
      If n = 5 Then
         ActiveSheet.HPageBreaks.Add Before:=Rows(m + 1)
         x = 1
         n = 0
      End If
   Next
End Sub

chxw68

lovespz 发表于 2020-2-19 22:05
非常感谢楼上大佬出手相助，实现了想要的功能。
另外请问一下，可以固定备注的一行文字在每页的底部吗？ ...

比较麻烦了。

lovespz

chxw68 发表于 2020-2-19 22:40
比较麻烦了。

好的，这样已经很好了。感谢！

SCL5801

Sub shet()
   Dim i&, n%, m
   With Worksheets("sheet1")
        ActiveSheet.ResetAllPageBreaks
        For i = 4 To .Range("a1048576").End(3).Row
           If Not .Range("a" & i).MergeCells Then
              n = n + 1
           End If
           If .Range("a" & i).MergeCells Then
              n = n + 1
              aa = .Range("A" & i).MergeArea.Address(1, 0)
              bb = Split(aa, ":")
              m = Val(Split(bb(1), "$")(1))
              i = m
           End If
           If n = 5 Then
              ActiveSheet.HPageBreaks.Add Before:=Rows(m + 1)
              n = 0
           End If
        Next
    End With
End Sub