在分頁符之間垂直合併相同的單元格

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