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

时间:2016-01-14 09:47:27

标签: excel vba excel-vba

我试图创建一个宏,它将一次滚动整个行的电子表格,并合并活动行中的所有单元格(如果它们有数据)。它应该这样做直到最后一行。

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

我目前的代码:

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

2 个答案:

答案 0 :(得分:0)

这是未经测试但应该做你想做的事。

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且语句b大于1,它将执行If语句

答案 1 :(得分:0)

@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