合并具有分页符的单元格，Excel没有响应

debugcn 发表于 Dev

约翰·坎普

我正在尝试将电子表格的选定列中的重复单元格合并在一起，而不必使合并的单元格跨分页符，以便在打印后可读。到目前为止，我所拥有的是：

Option Explicit

Sub MergeSameCells()

Application.DisplayAlerts = False

MergeCells:

For Each rng In Selection

    If rng.Offset(1, 0).Value And rng.Value <> "" And rng.Offset(1, 0).EntireRow.PageBreak = -4142 Then
        Range(rng, rng.Offset(1, 0)).Merge
        Range(rng, rng.Offset(1, 0)).HorizontalAlignment = xlCenter
        Range(rng, rng.Offset(1, 0)).VerticalAlignment = xlCenter
        GoTo MergeCells
    End If

Next

Application.DisplayAlerts = True

End Sub

这将导致VBA无限期运行，并且Excel给出“无响应”错误。是否有更好的方法来避免这些性能问题？

豪猪

这里有些错误：

通常，不要goto在错误处理之外使用语句（可能有一些例外，但这不是其中之一）。
您IF没有执行您在问题中指定的操作。

rng.Offset(1, 0).Value 只是试图求真，所以数字和布尔值而不是字符串。

rng.value <> "" 正在跳过空字符串，这可能是一个问题，因为合并的单元格仅从最左上角的地址获取值，如果您有三行需要合并在一起，它将始终跳过第二次合并。

您根本不需要比较单元格值。
这IF很可能经常是正确的，并且使用gotowill keep循环，会使您陷入无限循环

我相信这样的事情更符合您的需求：

    Dim rng As Range
    Dim rngval As Variant
    Dim rowoffset As Integer
    rowoffset = 0
    For Each rng In Selection 'It's generally not the best practice to use selection
        rngval = rng.Value
        Do While rngval = "" 
        'This loop will just keep plowing backwards until it finds a non empty value within your selection. 
        'That gets you the last cell that has a value as merge destroys the values.
            rngval = rng.Offset(rowoffset, 0).Value
            rowoffset = rowoffset - 1
        Loop
        If rngval = rng.Offset(1, 0).Value And rng.Offset(1, 0).EntireRow.PageBreak = -4142 Then 
            Range(rng, rng.Offset(1, 0)).Merge
        End If
        rowoffset = 0
    Next