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

【问题标题】：Excel VBA - Merge rows until last rowExcel VBA - 合并行直到最后一行
【发布时间】：2016-01-14 09:47:27
【问题描述】：

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

代码当前将所有行都视为空行，因此会跳过它们，我需要一个 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

【问题讨论】：

你有什么问题？
对不起！代码当前将所有行视为空行，因此跳过它们，我需要一个 if 条件或 do until 语句，这将有助于检测和跳过空行，检测包含数据的行并合并它们的单元格，并在到达最后一行时完全停止。
另外使用select 语句通常是危险的，应尽可能避免。它也只会减慢您的代码速度。你还想合并整行吗？
如果您有其他建议，我很乐意使用它。是的，如果所选行有数据，则该行的单元格应该合并。
我稍微改变了你的不使用 select 语句。但是，它未经测试。为什么要合并整行？我很确定这只会导致 Excel 出现问题

标签： vba excel

【解决方案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) 该行中是否还有其他单元格。如果语句 a 的计算结果为假且语句 b 大于 1，它将执行 If 语句

【讨论】：

奇怪的是，这段代码可以工作，但会返回错误。我得到了想要的效果，但是在线：ws.Rows(i & ":" & i).merge = True我得到错误 438 对象不支持此方法
对不起，你说的“在线：-”是什么意思
对不起，我想我可以在这里让自己更清楚。该代码一直有效，直到像 ws.Rows(i & ":" & i).merge = True 一样，此时它会引发运行时错误。奇怪的是，这段代码无论如何都可以工作，所以当我到达那一点时，它会合并单元格并且代码会从错误中停止。如果我调试它，触发错误，然后手动跳到下一行，它可以工作。
您可以通过用On Error Resume Next 和On Error Goto 0 包裹该行来隐藏此消息。合并整行也将丢失不在列A 中的所有数据。这是正确的吗？
我也是这么想的，而且成功了，谢谢。由于集成了代码，因此数据将仅被拉入 A 列。

【解决方案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

【讨论】：