gpt4 book ai didi

vba - 连接数据列

转载 作者:行者123 更新时间:2023-12-02 21:39:12 25 4
gpt4 key购买 nike

*编辑添加:我收到的当前错误。请参阅本文底部的屏幕截图。

我在 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 的优秀代码,但收到错误,如下面的屏幕截图所示

enter image description here

最佳答案

从底部开始向上构建一个字符串数组。当您到达空白单元格时,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_String_Lists_before
            在 build_StringLists 过程之前

       build_String_Lists_After
            build_StringLists 过程之后

关于vba - 连接数据列,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/34830468/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com