基于第一列合并单元格：VBA代码超出选定范围问题求助

我想基于第一列的值合并A1:D20区域的行，写了下面的VBA代码，但代码没有在选定范围的最后一行停止，反而超出了选定范围xRows行。

Sub MergeSameCell() 
Dim Rng As Range, xCell As Range 
Dim xRows As Integer 

Set WorkRng = Application.Selection 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
xRows = WorkRng.Rows.Count        
For Each Rng In WorkRng.Rows 
    For i = 1 To xRows - 1        
        For j = i + 1 To xRows   
            If Rng.Cells(j, 1).Value = "" Then Exit For
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then 
                Exit For 
            End If 
        Next 
        WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge 
        WorkRng.Parent.Range(Rng.Cells(i, 2), Rng.Cells(j - 1, 2)).Merge 
        WorkRng.Parent.Range(Rng.Cells(i, 3), Rng.Cells(j - 1, 3)).Merge 
        WorkRng.Parent.Range(Rng.Cells(i, 4), Rng.Cells(j - 1, 4)).Merge 
        i = j - 1 
    Next 
Next 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
End Sub

问题根源 #

原代码的循环逻辑完全混乱：

• 外层For Each Rng In WorkRng.Rows会遍历选定区域的每一行，同时内层又用i从1到xRows循环，相当于重复处理了整个区域多次，直接导致越界。
• 当用Rng.Cells(j,1)引用单元格时，Rng本身是单行区域，j大于1时，这个引用会指向当前行往下第j-1行的单元格，自然超出选定范围。

修正后的代码 #

直接基于选定区域的第一列分组合并，逻辑清晰且不会越界：

Sub MergeSameCell()
    Dim WorkRng As Range
    Dim lastRow As Long, i As Long, j As Long
    
    Set WorkRng = Application.Selection
    ' 空选择或行数不够直接退出
    If WorkRng Is Nothing Or WorkRng.Rows.Count < 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    lastRow = WorkRng.Rows.Count
    
    i = 1
    Do While i <= lastRow
        j = i
        ' 找到第一列连续相同值的最后一行
        Do While j <= lastRow And WorkRng.Cells(j, 1).Value = WorkRng.Cells(i, 1).Value
            j = j + 1
        Loop
        ' 一次性合并当前组的4列
        WorkRng.Parent.Range(WorkRng.Cells(i, 1), WorkRng.Cells(j - 1, 4)).Merge
        i = j
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

关键改进点 #

• 删掉了重复的For Each循环，用i和j精准遍历选定区域的行
• 用双层Do While锁定连续相同值的行范围，严格控制在lastRow以内，不会越界
• 合并时直接选中整组的4列区域，简化代码，减少重复操作
• 增加了有效性判断，避免空选择或无效区域导致报错

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