Excel VBA - 包含合并单元格的行，用于取消合并和连接数据的代码

Question

嗨-我一直卡在一些 VBA 上-我提取了一些显示在列中的数据-问题是第 3 列中的一些数据已放入 2 个单元格中-这意味着这 2 行中的所有相应单元格都已合并.我使用 VBA 完成的一种解决方法是拆分同一行中的任何合并单元格并将其内容复制到新的未合并单元格中 - 这实际上创建了很多重复数据 - 所以真的不想这样做

我不确定是否有人对此的最佳解决方案有任何想法。我真正想做的就是将第 3A 列数据与第 3B 列数据连接起来——因此将它们放在同一个单元格中并删除合并的单元格——但这可以是动态的，并且并非此列中的每一行都可以像这样拆分 见下文：

我使用过这段代码：这只会删除合并的单元格，并从对应的单元格中复制新空单元格中的数据。

Dim rng As Range, xCell As Range

Set WorkRng = recwbk.Worksheets(1).Range("A3:M" & recwbk.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each rng In WorkRng
    If rng.MergeCells Then
        With rng.MergeArea
            .UnMerge
            .Formula = rng.Formula
        End With
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

但我想要实现的是以下

Answer 1

Sub Tester22()

    Dim col As New Collection, maxRows As Long, n As Long
    Dim c As Range, c2 As range
    
    'loop over row2 and check for merged cells
    For Each c In ActiveSheet.Range("B2:G2").Cells
        n = c.MergeArea.Rows.Count
        If n > 1 Then
            If n > maxRows Then maxRows = n 'tracking max # rows merged
            c.UnMerge
        Else
            col.Add c 'not merged: deal with these later
        End If
    Next c
    
    'loop over the unmerged cells and pull content from the rows below
    For Each c In col
        For n = 2 To maxRows
            Set c2 = c.Offset(n - 1, 0)
            c.Value = c.Value & vbLf & c2.Value
            c2.ClearContents
        Next n
    Next c
End Sub