运行时错误'1004'：VBA合并同值单元格触发应用/对象定义错误

编写VBA实现选中区域内值相同的相邻单元格自动合并并居中对齐，调试运行时持续弹出运行时错误'1004': 应用程序定义或对象定义错误，原代码如下：

Sub MergeSameCells()

Application.DisplayAlerts = False

Dim rng As Range

MergeCells:

For Each rng In Selection

   If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" 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

End Sub

• 边界越界：遍历选中区域单元格时，当循环到选中区域最底部的单元格，rng.Offset(1, 0)会指向选中区域外侧的单元格，如果选中区域包含工作表最后一行，偏移后的单元格根本不存在，直接触发1004错误。
• 遍历逻辑混乱：每次完成2个单元格合并后就通过GoTo跳回循环起点重新遍历整个选中区域，此时选中区域内已经存在合并单元格，遍历合并单元格时的取值、偏移引用会出现异常，连续3个及以上同值单元格的场景下会反复操作已合并区域，进一步提升报错概率。
• 配置未恢复：代码开头关闭了Application.DisplayAlerts，但没有编写异常场景下恢复该配置的逻辑，出错后会导致Excel后续操作的提示弹窗被异常屏蔽。

调整遍历逻辑，从选中区域底部向上逐行判断同值单元格，移除不稳定的GoTo跳转，增加边界校验和配置恢复逻辑，修正后代码如下：

Sub MergeSameCells()
    Dim selectedRng As Range
    Dim i As Long, lastRow As Long, firstRow As Long, col As Long
    
    ' 校验选中对象是否为单元格区域
    If TypeName(Selection) <> "Range" Then
        MsgBox "请先选中需要处理的单元格区域！"
        Exit Sub
    End If
    Set selectedRng = Selection
    
    ' 关闭提示和屏幕更新，提升运行效率
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ' 逐列遍历选中区域
    For col = selectedRng.Column To selectedRng.Column + selectedRng.Columns.Count - 1
        firstRow = selectedRng.Row
        lastRow = firstRow + selectedRng.Rows.Count - 1
        ' 从区域底部向上逐行判断，规避偏移越界、合并后单元格位移问题
        For i = lastRow - 1 To firstRow Step -1
            If Cells(i, col).Value <> "" And Cells(i, col).Value = Cells(i + 1, col).Value Then
                Range(Cells(i, col), Cells(i + 1, col)).Merge
                ' 设置居中对齐
                With Range(Cells(i, col), Cells(i + 1, col))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
            End If
        Next i
    Next col

    ' 恢复Excel默认配置
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

修正点说明：

• 增加选中对象校验，避免选中非单元格对象时运行报错
• 改为从下往上的遍历方向，彻底解决边界偏移越界问题，连续同值单元格会在遍历过程中自动完成连续合并
• 移除GoTo跳转逻辑，避免重复遍历已处理区域导致的引用异常
• 增加配置恢复逻辑，代码运行结束后自动还原Excel的提示和屏幕更新设置，不影响后续操作

内容的提问来源于stack exchange，提问作者Austin Hlinka