如何自动合并单元格?

时间:2008-12-03 18:15:18

标签: excel vba excel-formula merge

我有一个包含多个项目1,2,3 ......的Excel表格,每个项目都有子项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是原始数据; AB是公式。

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

我不关心细胞是否合并或只是包裹和重叠。

可以在公式或VBA中完成吗?

2 个答案:

答案 0 :(得分:1)

扩展Jon Fournier的答案,我已经更改了范围计算以查找非空白单元格并添加了代码以关闭Merge引发的警告对话框。我还将函数更改为Public,以便我可以从Macros对话框中运行它。

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

Jon的第二部分,它应该在每次重新计算时都运行宏,但似乎没有用,但对我来说做的少量更新并不重要。

答案 1 :(得分:0)

这可以使用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