excel - 嵌套 For 循环替代方案或优化

Question

当前正在尝试将每行中的所有单元格附加到该行的第一个单元格中，并迭代每一行。问题是我正在处理大约 3000 行，每行大约 20 列数据。有没有更好的方法将一行中的所有单元格追加到一个单元格中而不使用 for 循环？这可以将代码范围缩小到单个 for 循环，并可能加快进程。

尝试创建一个嵌套的 for 循环，遍历每一行，然后遍历每一行的每一列。它可以工作，但在处理大量数据时花费的时间太长。

Sub AppendToSingleCell()

Dim value As String
Dim newString As String
Dim lastColumn As Long
Dim lastRow As Long


lastRow = Cells(Rows.Count, "A").End(xlUp).Row

For j = 1 To lastRow

    lastColumn = Cells(j, Columns.Count).End(xlToLeft).Column

    For i = 2 To lastColumn

     If IsEmpty(Cells(j, i)) = False Then
            value = Cells(j, i)
            newString = Cells(j, 1).value & " " & value
            Cells(j, 1).value = newString
            Cells(j, i).Clear
        End If

    Next i

Next j


End Sub

Answer 1

将所有内容加载到变体数组中并循环它而不是范围。将输出加载到另一个变量数组中，然后将该数据作为一个数据放回工作表中。

Sub AppendToSingleCell()

    With ActiveSheet

        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).row

        Dim lastColumn As Long
        lastColumn = .Cells.Find(What:="*", After:=.Range("a1"), LookIn:=xlValue, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

        Dim dtaArr() As Variant
        dtaArr = .Range(.Cells(1, 2), .Cells(lastRow, lastColumn)).value

        Dim otArr() As Variant
        ReDim otArr(1 To lastRow, 1 To 1)

        Dim i As Long
        For i = LBound(dtaArr, 1) To UBound(dtaArr, 1)
            For j = LBound(dtaArr, 2) To UBound(dtaArr, 2)
                If dtaArr(i, j) <> "" Then otArr(i, 1) = otArr(i, 1) & dtaArr(i, j) & " "
            Next j
            otArr(i, 1) = Application.Trim(otArr(i, 1))
        Next i

        .Range(.Cells(1, 2), .Cells(lastRow, lastColumn)).Clear
        .Range(.Cells(1, 1), .Cells(lastRow, 1)).value = otArr

    End With


End Sub