vba 如何自动合并单元格？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/338185/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to automatically merge cells?
提问by
I have an Excel table with several items 1, 2, 3..., each of which has subitems 1.1, 1.2, etc. I'm using the list of subitems as my key column and populating the main items using vlookups, but only showing each main item once.
我有一个 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 |
Column Cis raw data; Aand Bare formulas.
列C是原始数据；A并且B是公式。
Column Bhas notes, so the text may be long. I want to wrap the notes to take up all the rows available. I can do this manually by selecting B1:B3and merging them, but then it won't update if I add items to column C.
专栏B有注释，所以文字可能很长。我想包装笔记以占用所有可用的行。我可以通过选择B1:B3和合并它们来手动执行此操作，但是如果我将项目添加到 column ，它就不会更新C。
I don't care if the cells are merged or just wrapped and overlapping.
我不在乎单元格是合并还是只是包裹和重叠。
Can this be done in formulas or VBA?
这可以在公式或 VBA 中完成吗？
回答by
Extending Jon Fournier's answer, I've changed the range calculation to look for non-blank cells and added code to turn off the warning dialog that Merge throws up. I also changed the function to Public so I could run it from the Macros dialog.
扩展 Jon Fournier 的回答，我更改了范围计算以查找非空白单元格并添加代码以关闭 Merge 抛出的警告对话框。我还将该函数更改为 Public，以便我可以从“宏”对话框中运行它。
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's second part, which should run the macro at every recalculate, doesn't seem to work but doesn't matter to me for the small amount of updating I'm doing.
Jon 的第二部分应该在每次重新计算时运行宏，它似乎不起作用，但对于我正在做的少量更新来说对我来说无关紧要。
回答by Jon Fournier
This is possible using VBA, thought I don't know if you can do it without VBA. Basically what you would do is every time your worksheet calculates you run the code to re-merge the cells.
使用 VBA 可以做到这一点，我想我不知道您是否可以在没有 VBA 的情况下做到这一点。基本上，您每次计算工作表时都会运行代码以重新合并单元格。
I built a simple spreadsheet similar to yours and put the following code in the sheet's code module:
我构建了一个类似于您的简单电子表格，并将以下代码放入工作表的代码模块中：
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
