时间戳

首页 > 解决方案 > 在 VBA 中合并多行

excel - 在 VBA 中合并多行

问题描述

我正在尝试创建一个简单的子例程，如果 A 列中的单元格包含相同的数字数据，它将合并多行。

Option Explicit

Sub MergeRows()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim lastRow As Long
Dim i As Long

lastRow = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow

    
    If ThisWorkbook.Worksheets(1).Cells(i, 1).Value = _
    ThisWorkbook.Worksheets(1).Cells(i + 1, 1).Value Then
    ThisWorkbook.Worksheets(1).Range(ThisWorkbook.Worksheets(1) _
    .Cells(i, 1), ThisWorkbook.Worksheets(1).Cells(i + 1, 1)).Merge
    
    Else
    
    End If
    
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

上面的代码一次只合并 2 行，所以如果有 3 行具有相同的值，它将合并两行，然后将剩余的一行留给它自己。

标签： excelvba

解决方案

我添加了一个 While 循环，它继续检查相邻单元格的相同值，直到找到不同的值。我还在您的第一个 If 语句中添加了一个检查，以确保它所比较的​​值不是空白值。

为了使事情更容易阅读，我还将工作表引用移到了 With 块中，因此不会在整个代码中不必要地重复它。

Option Explicit

Sub MergeRows()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim lastRow As Long
Dim i As Long, r As Long

With ThisWorkbook.Worksheets(1)

    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    
    For i = 1 To lastRow
    
        If .Cells(i, 1).Value <> "" _
        And .Cells(i, 1).Value = .Cells(i + 1, 1).Value _
        Then
            r = 1
            While .Cells(i + r, 1) = .Cells(i, 1).Value
                r = r + 1
            Wend
            .Cells(i, 1).Resize(r).Merge
        Else
        
        End If
    
    Next i
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

旁注：您可以通过i = i + r在 之后直接添加一行.Merge来将循环推进到下一个非合并单元格，从而节省迭代次数。

推荐阅读