合并+取消合并单元格，基于第一列对表进行归一化; 在合并的内容之间插入换行符

我有一个Excel工作表的单元格在一些列合并：

我需要对它进行标准化，使得第一列中的单元格未被合并（这些应该被视为真正的“行”），但是这样一些未合并的单元格组（在这些“行”中）被放入一个带有换行符保留列表式的内容：

请注意，除了第一列以外的一些列中，也可能有一些合并的单元格，但无论如何，第一列应该确定输出表中的“行”应该是什么样子。

这样的VBA脚本是否存在这样做？

更新 ：这是我想要的一个小的伪代码：

foreach row: determine height of merged cell in column A unmerge cell in column A (content is in top cell of range?) for each column after A: if cell is merged, unmerge (content is in top cell of range?) else concatenate cell contents with newline separator in top cell of row range cleanup excess rows from the unmerging 

不幸的是，我认为在这些步骤中有一些复杂性。

更新＃2 ：根据接受的答案，我创build了一些新的代码来实现我的目标：

 Sub dlo() Dim LastRow&, r&, c&, rowheight&, n&, Content$, NewText$ Application.DisplayAlerts = False LastRow = Cells(Rows.Count, 1).End(xlUp).Row LastCol = Cells(1, Columns.Count).End(xlToLeft).Column For r = 1 To LastRow If Cells(r, 1).MergeCells Then rowheight = Cells(r, 1).MergeArea.Cells.Count For c = 1 To LastCol NewText = vbNullString For rr = r To (r + rowheight - 1) Content = Cells(rr, c) Cells(rr, c) = vbNullString NewText = NewText & vbCrLf & Content Next Cells(r, c).UnMerge Cells(r, c) = NewText Next 'Cells(i + 1, 1).Resize(k - 1, 2).Delete Shift:=xlUp 'LastRow = LastRow - rowheight + 1 End If DoEvents Next Application.DisplayAlerts = True End Sub 

我没有完成的唯一的事情就是删除产生的空白行（我最终只是评论这些，因为我知道可以sorting表来消除空白）。

如果任何人有更好的想法如何描述这个，请让我知道，所以我可以编辑标题…我有一种感觉，这不是一个罕见的需要，所以我想帮助其他人find这个。

Answer 1

这是你要求的吗？

 Sub dlo() Dim LastRow&, i&, j&, k&, n&, Content$, Text$ Application.DisplayAlerts = False LastRow = Cells(Rows.Count, 1).End(xlUp).Row Do i = i + 1 Text = vbNullString If Cells(i, 1).MergeCells Then k = Cells(i, 1).MergeArea.Cells.Count n = Cells(i, 1).RowHeight For j = 1 To k Content = Cells(j + i - 1, 2) Cells(j + i - 1, 2) = vbNullString Text = Text & vbCrLf & Content Next Cells(i, 1).UnMerge Cells(i, 2) = Mid(Text, 3) Cells(i + 1, 1).Resize(k - 1, 2).Delete Shift:=xlUp Rows(i).RowHeight = n * k NewLastRow = LastRow - k + 1 End If DoEvents Loop Until i = NewLastRow Application.DisplayAlerts = True End Sub 

上面的代码适用于我的虚拟数据。