如何自动合并单元格？

Question

我有一个 Excel 表格，其中包含多个项目 1、2、3...，每个项目都有子项目 1.1、1.2 等。我使用子项目列表作为我的关键列，并使用 vlookups 填充主要项目，但仅每个主要项目显示一次。

/|    A    |    B     |    C     |
-+---------+----------+----------+
1| Item1   |  1.Note  |  Item1.1 |
2|         |          |  Item1.2 |
3|         |          |  Item1.3 |
4| Item2   |  2.Note  |  Item2.1 |
5|         |          |  Item2.2 |
6|         |          |  Item2.3 |
7|         |          |  Item2.4 |
8| Item3   |  3.Note  |  Item3.1 |
9|         |          |  Item3.2 |
0|         |          |  Item3.3 |

C 列是原始数据； A 和 B 是公式。

B 列有注释，因此文本可能会很长。 我想将笔记包裹起来以占据所有可用的行。 我可以通过选择 B1:B3 并合并它们来手动执行此操作，但如果我将项目添加到 C 列，它就不会更新。

我不在乎单元格是否合并或只是包裹和重叠。

可以用公式或 VBA 来完成吗？

Answer 1

扩展 Jon Fournier 的答案，我更改了范围计算以查找非空白单元格，并添加了代码以关闭合并抛出的警告对话框。 我还将该函数更改为“公共”，这样我就可以从“宏”对话框中运行它。

Public Sub AutoMerge()

Dim LastRowToMergeTo As Long
Dim i As Long
Dim LastRow As Long

Application.DisplayAlerts = False

LastRow = Range("S" & CStr(Rows.Count)).End(xlUp).Row

For i = 2 To LastRow

    LastRowToMergeTo = i
    Do While (Len(Range("D" & CStr(LastRowToMergeTo + 1)).Value) = 0) And (LastRowToMergeTo <> LastRow)
        LastRowToMergeTo = LastRowToMergeTo + 1
    Loop

    With Range("D" & CStr(i) & ":D" & CStr(LastRowToMergeTo))
        .Merge
        .WrapText = True
        .VerticalAlignment = xlVAlignTop
    End With

    i = LastRowToMergeTo

Next i

Application.DisplayAlerts = True

End Sub

乔恩的第二部分应该在每次重新计算时运行宏，似乎不起作用，但对于我正在做的少量更新来说并不重要。

Answer 2

使用VBA可以做到这一点，我想我不知道如果不使用VBA是否可以做到这一点。 基本上，您要做的就是每次工作表计算时运行代码来重新合并单元格。

我构建了一个与您类似的简单电子表格，并将以下代码放入工作表的代码模块中：

Private Sub AutoMerge()

Dim LastRowToMergeTo As Long
Dim i As Long
Dim LastRow As Long

LastRow = Range("C" & CStr(Rows.Count)).End(xlUp).Row

For i = 2 To LastRow

    LastRowToMergeTo = Range("B" & CStr(i)).End(xlDown).Row - 1
    LastRowToMergeTo = Application.WorksheetFunction.Min(LastRowToMergeTo, LastRow)

    With Range("B" & CStr(i) & ":B" & CStr(LastRowToMergeTo))
        .Merge
        .WrapText = True
        .VerticalAlignment = xlVAlignTop
    End With

    i = LastRowToMergeTo

Next i

End Sub

Private Sub Worksheet_Calculate()
    AutoMerge
End Sub