如果数据相同，则合并两行特定列？

Question

我有如下输入

我需要如下输出

如果数据与公式相同，基本上如何仅合并A列相邻值？这是一张巨大的床单。我想应用公式，使任务自动化。

Answer 1

Sub G()

    Dim x&, start&, bottom&
    Application.DisplayAlerts = False

    '// Start from row two
    '// In your sample it's value "Text1"
    x = 2

    While Not IsEmpty(Cells(x, 1))

        '// "start" designates the start row with new text (see below)
        start = x

        '// As soon as we defined start row with new text, it's time to define the last row.
        '// Cells(x, 1) - is new text value
        '// SearchDirection:=xlPrevious means that search must be done from bottom of sought range
        '// This also means that no extra data must be under your data.
        '// So, this way we can get to know full range.
        '// For single distinct value the start and bottom will be the same row.
        bottom = Range("A:A").Find(Cells(x, 1), SearchDirection:=xlPrevious).Row

        '// Having start and bottom rows,
        '// we can get full range with new text by using Resize property.
        '// It sets new number of rows and columns having top-left cell as a start point.
        Cells(start, 1).Resize(bottom - start + 1).Merge

        '// The next cell after bottom cell is new value.
        x = bottom + 1

    Wend

    Application.DisplayAlerts = True

End Sub