问题

目前正在尝试将每行中的所有单元格附加到该行的第一个单元格中,并遍历每行.问题是我正在处理约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
 

  最佳答案

将所有内容加载到变体数组中并循环,而不是range.将输出加载到另一个变体数组中,然后将该数据作为一个数据放回表中.

 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
 

  相同标签的其他问题

excelvbafor-loop