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

Question

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

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 出现"无响应"错误。有没有更好的方法来避免这些性能问题？

Answer 1

这里有一些问题：

1. 作为一般规则，不要在错误处理之外使用goto语句(可能有一些例外，但这不是其中之一(。

2. 您的IF没有按照您在问题中指定的内容进行操作。

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

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

   您根本不是在比较单元格值。

3. 这种IF很可能经常是正确的，并且随着goto会保持循环，让你陷入无限循环

我相信这样的东西更符合您正在寻找的内容：

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