Excel 垂直合并分页符之间的相同单元格

我希望在已设置的分页符之间垂直合并Excel A列中的单元格（即，防止合并分页符）。我有告诉行分页符所在位置的代码，以及合并范围列A中的单元格的代码，如果两个或多个相邻单元格相同（代码如下所示），现在我试图找出如何合并两个代码段（代码如下所示），以便只合并整页上的相同单元格，而不合并已设置的分页符。有人能想出解决办法吗？非常感谢

查找现有分页符行数的代码：

Sub PageBreakAddresses() 'this finds row of pagebreak
    Dim pb As HPageBreak

    For Each pb In Sheet1.HPageBreaks
        MsgBox pb.Location.row - 1
    Next
End Sub

Sub MergeCells()  ' this merges identical cells in column A

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rngMerge As Range, cell As Range
    Dim i As Long
    i = Cells(Rows.Count, "A").End(xlUp).row
    Set rngMerge = Range("A1:A" & i)

MergeAgain:
    For Each cell In rngMerge
        If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
            Range(cell, cell.Offset(1, 0)).Merge
            GoTo MergeAgain
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub 

在A列中合并相同单元格的代码：

Sub PageBreakAddresses() 'this finds row of pagebreak
    Dim pb As HPageBreak

    For Each pb In Sheet1.HPageBreaks
        MsgBox pb.Location.row - 1
    Next
End Sub

Sub MergeCells()  ' this merges identical cells in column A

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rngMerge As Range, cell As Range
    Dim i As Long
    i = Cells(Rows.Count, "A").End(xlUp).row
    Set rngMerge = Range("A1:A" & i)

MergeAgain:
    For Each cell In rngMerge
        If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
            Range(cell, cell.Offset(1, 0)).Merge
            GoTo MergeAgain
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub 

---

合并单元格后，执行此代码

Sub ResetHPage()
    Dim WS As Worksheet
    Dim rng As Range, rngST As Range, rngEnd As Range
    Dim vHrow()
    Dim C As Integer, n As Long, k As Long, i As Long
    Dim mergeValue

    ActiveWindow.View = xlPageBreakPreview


    Set WS = ActiveSheet
    C = WS.Cells.SpecialCells(xlCellTypeLastCell).Column

    n = WS.HPageBreaks.Count

    For i = 1 To n
        k = k + 1
        ReDim Preserve vHrow(1 To k)
        vHrow(k) = WS.HPageBreaks(k).Location.Row
    Next i
    For i = 1 To n
        For Each rng In Range("a" & vHrow(i), Cells(vHrow(i), C))
            If rng.MergeCells Then
                With rng.MergeArea
                    If rng.Address = .Range("a1").Address Then
                    Else
                        mergeValue = .Range("a1")

                        Set rngST = .Range("a1")
                        Set rngEnd = rng.MergeArea(.Rows.Count)

                        .UnMerge
                        rng = mergeValue
                        Range(rngST, rng.Offset(-1, 0)).Merge
                        Range(rng, rngEnd).Merge
                    End If
                End With
            End If
        Next rng
    Next i

    WS.UsedRange.Borders.LineStyle = xlContinuous
End Sub

---

运行代码MergeCells后，运行mycode。谢谢你的代码，Dy Lee。到目前为止，我对您提供的代码进行了一个小测试，它似乎完成了我希望它完成的任务！我确实注释掉了倒数第二行

WS.UsedRange.Borders.LineStyle=xlContinuous

，因为我不需要绘制边界线。在接下来的几天里，我需要在我的完整报告中对它进行更深入的测试，以了解它的总体效果。但是到目前为止，非常好！非常感谢。如果您有时间，请您记录您的代码，以便我能够更好地理解它正在做什么，以及它在做什么？我想稍微修改一下，将txt.Colums（1）居中合并。horizontalalignment=xlcenter感谢

Colums（1）。horizontalalignment=xlcenter

提示。我希望明天有更多的时间来测试和进一步研究您的代码。到目前为止，它看起来和工程伟大！谢谢上面的代码已经过测试，在我的例子中效果很好。谢谢你，李迪！