VBA循环单行选择并执行concat代码

Question

所以，我一直在摸索几个小时，试图弄清楚这一点。无论我在哪里看和做什么，我似乎都无法让它发挥作用。

我有一个大约 20 列和完全可变的行数的 excel 文档。我想将定义宽度（列 A：V）内的每个相邻单元格连接到第一个单元格（第一行为 A1），然后移动到下一行并执行相同操作，直到我到达底部。以下片段：

Example before and after I'm trying to make

我有执行连接的代码。为了使其工作，我必须选择要连接的单元格（A1：V1），然后执行代码。即使某些单元格是空白的，我也需要代码以这种方式处理它们并将分号留在那里。代码完全按照我的需要工作，所以我一直在尝试将它包装在某种范围选择、偏移、循环中：

    Dim c As Range
    Dim txt As String

    For Each c In Selection
        txt = txt & c.Value & ";"

    Next c

    Selection.ClearContents
    txt = Left(txt, Len(txt) - 2)
    Selection(1).Value = txt

我正在努力选择 A1:V1，运行代码，然后将其循环到 A2:V1、A3:V3 等。我认为这可以通过循环和偏移量来完成，但是我无法为我的生活弄清楚如何。

任何帮助将不胜感激:)

Answer 1

这使用变体数组并且会非常快

Dim rng As Range
With Worksheets("Sheet4") 'change to your sheet
    'set the range to the extents of the data
    Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 22).End(xlUp))

    'Load data into an array
    Dim rngArr As Variant
    rngArr = rng.Value

    'create Out Bound array
    Dim OArr() As Variant
    ReDim OArr(1 To UBound(rngArr, 1), 1 To 1)

    'Loop array
    Dim i As Long
    For i = LBound(rngArr, 1) To UBound(rngArr, 1)
        'Combine Each Line in the array and load result into out bound array
        OArr(i, 1) = Join(Application.Index(rngArr, i, 0), ";")
    Next i

    'clear and load results
    rng.Clear
    rng.Cells(1, 1).Resize(UBound(OArr, 1)).Value = OArr

End With

Answer 2

这是我为此编写的一个快速小脚本 - 需要注意的主要是我不使用选择，而是使用定义的范围。

Sub test()

    Dim i As Long

    Dim target As Range
    Dim c As Range

    Dim txt As String

    For i = 3 To 8
        Set target = Range("A" & i & ":C" & i)
        For Each c In target
            txt = txt & c.Value & ";"
        Next c
        Cells(i + 8, "A").Value2 = Left$(txt, Len(txt) - 1)
        txt = ""
    Next i

End Sub

Answer 3

只需将以下范围更改为您的要求：

Sub concat_build()
    Dim buildline As String
    Dim rw As Range, c As Range
    With ActiveSheet
    For Each rw In .Range("A2:V" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).Rows
        buildline = ""
        For Each c In rw.Cells
            If buildline <> "" Then buildline = buildline & ";"
            buildline = buildline & c.Value2
        Next
        rw.EntireRow.ClearContents
        rw.EntireRow.Cells(1, 1) = buildline
    Next
    End With
End Sub