*编辑添加:我收到的当前错误。请参阅本文底部的屏幕截图。
我在 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 的优秀代码,但收到错误,如下面的屏幕截图所示
最佳答案
从底部开始向上构建一个字符串数组。当您到达空白单元格时,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
我留下了用于反转字符串列表以及删除原始字符串行的选项。
关于vba - 连接数据列,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/34830468/