Excel 在不规则多行合并的多个单元格，自动插入分页符

plaodj

在excel中   不规则合并的单元格 自动加入分页符  如图


效果如图


宏代码：

[mw_shl_code=vb,true]Sub l()
    Dim i As Integer, j As Integer
    With Sheet1
        i = .[b65536].End(3).Row
        .HPageBreaks.Add .Cells(i + 1, 1)
        .PageSetup.PrintArea = .Range("a1:h" & i).Address
        For j = 3 To i
            If Len(.Cells(j, 1)) Then .HPageBreaks.Add .Cells(j, 1)
        Next
    End With
End Sub[/mw_shl_code]

宏代码2：设置第一行为顶端标题。
[mw_shl_code=vb,true]Sub l()
    Dim i As Integer, j As Integer
    With Sheet1
        i = .[b65536].End(3).Row
        .HPageBreaks.Add .Cells(i + 1, 1)
        .PageSetup.PrintArea = .Range("a1:h" & i).Address
        .PageSetup.PrintTitleRows = "$11"
        For j = 3 To i
            If Len(.Cells(j, 1)) Then .HPageBreaks.Add .Cells(j, 1)
        Next
    End With
End Sub[/mw_shl_code]

在A列数值间插入空白行.rar (6.15 KB, 下载次数: 621)

2018-4-7 22:15 上传

点击文件名下载附件
EH(AVEL)-在A列数值之间插入分页符 12-09-10 02-32.rar (15.33 KB, 下载次数: 541)

2018-4-7 22:15 上传

点击文件名下载附件

plaodj

[mw_shl_code=vb,true]Option Explicit

Sub l()
    Dim i As Integer, j As Integer
    insert_h
    With Sheet1
        i = .[b65536].End(3).Row
        .HPageBreaks.Add .Cells(i + 1, 1)
        .PageSetup.PrintArea = .Range("a1:h" & i).Address
        .PageSetup.PrintTitleRows = "$11"
        For j = 3 To i
            If Len(.Cells(j, 1)) Then .HPageBreaks.Add .Cells(j, 1)
        Next
    End With
End Sub
Sub insert_h()
    Dim i As Integer
    Dim j As Integer
    With Sheet1
        For i = .[a65536].End(3).Row To 3 Step -1
            If Len(.Cells(i, 1)) Then .Rows(i).Insert Shift:=xlDown
        Next
    End With
End Sub
[/mw_shl_code]

plaodj

[mw_shl_code=vb,true]Option Explicit
Sub l()
    Dim i As Integer, j As Integer
    insert_h
    With Sheet1
        i = .[b65536].End(3).Row
        .HPageBreaks.Add .Cells(i + 1, 1)
        .PageSetup.PrintArea = .Range("a1:h" & i).Address
        .PageSetup.PrintTitleRows = "$11"
        For j = 3 To i
            If Len(.Cells(j, 1)) = 0 Then .HPageBreaks.Add .Cells(j + 1, 1)
        Next
    End With
End Sub
Sub insert_h()
    Dim i As Integer
    Dim j As Integer
    With Sheet1
        For i = .[a65536].End(3).Row To 3 Step -1
            If .Cells(i, 1) <> .Cells(i - 1, 1) Then .Rows(i).Insert Shift:=xlDown
        Next
    End With
End Sub[/mw_shl_code]

plaodj

[mw_shl_code=vb,true]Sub l()
    Dim i As Integer, j As Integer
    insert_h
    With Sheet1
        i = .[b65536].End(3).Row
        .HPageBreaks.Add .Cells(i + 1, 1)
        .PageSetup.PrintArea = .Range("a1:h" & i).Address
        .PageSetup.PrintTitleRows = "$11"
        For j = 3 To i
            If Len(.Cells(j, 1)) = 0 Then .HPageBreaks.Add .Cells(j + 1, 1)
        Next
    End With
End Sub[/mw_shl_code]

[mw_shl_code=vb,true]Option Explicit
Sub l()
    Dim i As Integer, j As Integer
    Dim rng As Range
    On Error Resume Next
    Set rng = Sheet1.Range("b:b").SpecialCells(xlCellTypeBlanks)
    If Not rng Is Nothing Then rng.EntireRow.Delete
    insert_h
    With Sheet1
        .Range("f:h").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=SUMIF(C1,R[-1]C1,C)"
        i = .[b65536].End(3).Row
        .HPageBreaks.Add .Cells(i + 1, 1)
        .PageSetup.PrintArea = .Range("a1:h" & i).Address
        .PageSetup.PrintTitleRows = "$11"
        For j = 3 To i
            If Len(.Cells(j, 1)) = 0 Then .HPageBreaks.Add .Cells(j + 1, 1)
        Next
    End With
End Sub
Sub insert_h()
    Dim i As Integer
    Dim j As Integer
    With Sheet1
        For i = .[a65536].End(3).Row To 3 Step -1
            If .Cells(i, 1) <> .Cells(i - 1, 1) Then .Rows(i).Insert Shift:=xlDown
        Next
    End With
End Sub[/mw_shl_code]