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

Question

我想在已设置的分页符之间（即防止合并分页符）在列A中的Excel中垂直合并单元格。如果两个或多个相邻单元格相同（下面显示的代码），我有代码告诉页面中断所在的行，以及代码来合并范围列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 

代码在列A合并相同的细胞：

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 

Answer 1

合并细胞后，执行该代码。

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