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