Excel VBA 合并单元格适应分页打印

1. 先ALT+F11

2. 在打开的页面菜单中点击<插入>-<模块>，然后将下面的代码粘贴进去

Sub 重组跨页合并() '将跨页的合并单元格重新合并从而适应分页打印

    Dim p, MerageAddress As String, PageCell As Range, MergeValue

    Application.ScreenUpdating = False

    ActiveWindow.View = xlPageBreakPreview '进入分页预览，才可以判断分页符位置

    For Each p In ActiveSheet.HPageBreaks  '逐页循环 hpagebreaks对象，打印区域内水平分页符的集合

        'hpagebreak.location属性，返回或设置定义分页符位置的单元格（range对象）

        Set PageCell = Cells(p.Location.Row - 1, ActiveCell.Column) '将每个分页最后一个单元格赋予变量

        '如果该页最后一个单元格具有合并属性，而且与下一页第一个单元格处于同一个合并区域

        If PageCell.MergeCells And Not Intersect(Cells(p.Location.Row, ActiveCell.Column), PageCell.MergeArea) Is Nothing Then

            MerageAddress = PageCell.MergeArea.Address '取得合并区域的地址

            MergeValue = PageCell.MergeArea(1).Value '取得合并区域的值

            PageCell.MergeArea.UnMerge '取消合并

            Range(Range(MerageAddress)(1), PageCell).Merge '将合并区域中处于本页的单元格合并

            Range(Range(MerageAddress)(1), PageCell).Borders.LineStyle = xlContinuous '添加边框

            With Range(PageCell.Offset(1, 0), Cells(Split(MerageAddress, "$")(4), ActiveCell.Column))

                .Merge '再将合并区域中处于下一页的单元格合并

                .Value = MergeValue '赋值

                .HorizontalAlignment = xlCenter '左右居中

                .VerticalAlignment = xlCenter '上下居中

                .Borders.LineStyle = xlContinuous

            End With

        End If

    Next

    Application.ScreenUpdating = True

    ActiveWindow.View = xlNormalView '还原为常规视图

End Sub

3. 最后选中需要合并打印的列，然后执行代码