连接数据列

Question

*编辑添加：我收到的当前错误。截图见本帖底部。

我在 D 列中有文本。宏应该找到空白单元格，然后将其下方所有单元格中的文本连接起来。

示例

从 D2 开始的文本，显示如下...

Blank Cell
SampleText1
SampleText2
SampleText3
Blank Cell
SampleText4
SampleText5
SampleText6

宏应该在 D2 中显示文本...

SampleText1, SampleText2, SampleText3

然后在 D6 中，像这样......

SampleText4, SampleText5, SampleText6

..等等。

这只需要在 D 列中起作用，所以我猜我可以将它写入该范围。

我遇到的最接近的答案在这里： Excel Macro to concatenate

这是我目前正在使用的代码...

Sub ConcatColumns()

   Do While ActiveCell <> ""  'Loops until the active cell is blank.

      'The "&" must have a space on both sides or it will be
      'treated as a variable type of long integer.

      ActiveCell.Offset(0, 1).FormulaR1C1 = _
         ActiveCell.Offset(0, -1) & " " & ActiveCell.Offset(0, 0)

      ActiveCell.Offset(1, 0).Select
   Loop

End Sub

编辑：现在使用来自@jeeped 的优秀代码，但收到错误，如下图所示

Answer 1

从底部开始，逐步构建字符串数组。当您到达一个空白单元格时，Join 使用您喜欢的分隔符的字符串。

Sub build_StringLists()
    Dim rw As Long, v As Long, vTMP As Variant, vSTRs() As Variant
    Dim bReversedOrder As Boolean, dDeleteSourceRows As Boolean
    ReDim vSTRs(0)

    bReversedOrder = False
    dDeleteSourceRows = True

    With Worksheets("Sheet4")
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            If IsEmpty(.Cells(rw, 1)) Then
                ReDim Preserve vSTRs(0 To UBound(vSTRs) - 1)
                If Not bReversedOrder Then
                    For v = LBound(vSTRs) To UBound(vSTRs) / 2
                        vTMP = vSTRs(UBound(vSTRs) - v)
                        vSTRs(UBound(vSTRs) - v) = vSTRs(v)
                        vSTRs(v) = vTMP
                    Next v
                End If
                .Cells(rw, 1) = Join(vSTRs, ", ")
                .Cells(rw, 1).Font.Color = vbBlue
                If dDeleteSourceRows  Then _
                    .Cells(rw, 1).Offset(1, 0).Resize(UBound(vSTRs) + 1, 1).EntireRow.Delete
                ReDim vSTRs(0)
            Else
                vSTRs(UBound(vSTRs)) = .Cells(rw, 1).Value2
                ReDim Preserve vSTRs(0 To UBound(vSTRs) + 1)
            End If
        Next rw
    End With

End Sub

我留下了用于反转字符串列表以及删除原始字符串行的选项。

      
            ^{在 build_StringLists 过程之前}

      
            ^{在 build_StringLists 程序之后}