Vba 合并+;根据第一列取消单元格合并以规范化表格;在合并内容之间插入换行符

Vba 合并+;根据第一列取消单元格合并以规范化表格;在合并内容之间插入换行符,vba,excel,Vba,Excel,我有一张Excel表格,其中某些列中的单元格被合并: 我需要对其进行规范化,以使第一列中的单元格未合并(应将其视为真正的“行”),但将未合并的单元格组(在这些“行”中)放入带有换行的单个单元格中,以保留类似列表的内容: 请注意,在除第一列之外的某些列中,也可能有一些合并的单元格,但在任何情况下,第一列都应确定输出表中的“行”应该是什么样子 是否存在这样的VBA脚本来执行此操作 更新:以下是我所想的一些伪代码: foreach row: determine height of merged

我有一张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:根据公认的答案,我创建了一些新代码来实现我的目标:

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
我唯一没有完成的事情是删除生成的空白行(我最后只是注释掉这些行,因为我知道a可以对表进行排序以消除空白)


如果有人对如何描述这个有更好的想法,请让我知道,这样我可以编辑标题。。。我觉得这不是一种罕见的需要,所以我想帮助其他人找到它。

这就是你想要的吗

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

上面的代码对我的虚拟数据很有效。

合并单元格将有一个
MergeArea.Rows.Count
>1-将
MergeArea
偏移一列将得到ColB中相应的单元格(不考虑其他列中可能合并的单元格,但需要更具体)@我同意,合并的细胞很臭。我收到的表格中有合并的单元格;我要生成的工作表没有合并的单元格。。。实际内容将在由换行符分隔的正常单元格中。除了工作表很大这一事实之外,这在没有脚本的情况下是不可能完成的,因为如果我简单地合并单元格,内容将在没有任何分隔符的情况下连接起来。哇。。。非常感谢!它并没有完全满足我的需求,但你给了我足够的结构,让我能够到达我需要去的地方。我将添加上面使用的源代码。至少从分析的角度来看,这似乎是一个可怕的想法。也许从演讲的角度来看,这是有道理的。小心合并的单元格。最终你会在这些事情上遇到各种各样的问题。