Excel VBA-合并行直到最后一行

Question

我正在尝试创建一个宏，该宏将一次在整个电子表格中滚动浏览整个行，并合并活动行中所有具有数据的单元格。 它应该这样做直到最后一行。

该代码当前将所有行视为空，因此跳过它们，我需要一个if条件或do until语句，该语句将有助于检测和跳过空行，检测包含数据的行并合并其单元格并在到达最后一行时完全停止。

我当前的代码：

Sub merge()
Dim LastRow As Long, i As Long
    Sheets("Body").Activate
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Rows("1:1").Select
    For i = 1 To LastRow
        If Range("A" & i).Value = "*" Then
            Selection.merge = True
            Selection.Offset(1).Select
        Else
            Selection.Offset(1).Select
        End If
    Next i
    End Sub

我也尝试过：

sub merge2()
Dim LastRow As Long, i As Long
    Sheets("Body").Activate
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Rows("1:1").Select
    Do Until ActiveCell.EntireRow > LastRow
    'this line below was a concept
        If ActiveCell.EntireRow & ActiveCell.Column.Value = "*" Then
            Selection.merge = True
            Selection.Offset(1).Select
        Else
            Selection.Offset(1).Select
        End If
    Loop
End Sub

Answer 1

这未经测试，但应该做您想要的。

Option Explicit
Sub merge()
    Dim ws As Worksheet
    Dim LastRow As Integer, i As Integer

    Set ws = ThisWorkbook.Sheets("Body")

    ws.Activate

    With ws
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    For i = 1 To LastRow       
        If Not IsEmpty(Range("A" & i)) And ws.Cells(i, Columns.Count).End(xlToLeft).Column > 1 Then
            ws.Rows(i & ":" & i).merge
        End If
    Next i
End Sub

该If将测试a）列A中的单元格是否为空，以及b）该行中是否还有其他单元格。 如果if语句a的计算结果为false AND语句b大于1，它将执行If语句

Answer 2

@Tom我已经接受了您的代码，并添加了一个错误处理程序，该程序使它可以正常运行，非常感谢您的耐心等待，您提供了极大的帮助。

Sub merge2()
    Dim ws As Worksheet
    Dim LastRow As Integer, i As Integer

Set ws = ThisWorkbook.Sheets("Body")

ws.Activate

With ws
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

For i = 1 To LastRow
    If Not IsEmpty(Range("A" & i)) And ws.Cells(i, Columns.Count).End(xlToLeft).Column >= 1 Then
        On Error Resume Next
        ws.Rows(i & ":" & i).merge = True
    End If
Next i
End Sub