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

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

1 个答案: