Question

所以，我现在已经抓了几个小时试图解决这个问题。无论我在哪里，我在做什么，我似乎无法使其发挥作用。

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

Example before and after I'm trying to make

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

    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

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

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 2

只需根据您的要求更改以下范围：

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

Answer 3

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

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

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

3 个答案: