Excel 嵌套循环替代方案或优化

当前正在尝试将每行中的所有单元格追加到该行的第一个单元格中，并遍历每一行。问题是我要处理大约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

---

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

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

---

有点长，但很直截了当。 代码注释中的解释

代码

“==============================================================================================================================

Function FindLastCol(Sht As Worksheet) As Long    
' This Function finds the last col in a worksheet, and returns the column number

Dim LastCell As Range

With Sht
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), LookAt:=xlPart, LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then
        FindLastCol = LastCell.Column
    Else
        MsgBox "Error! worksheet is empty", vbCritical
        Exit Function
    End If
End With

End Function

Function FindLastRow(Sht As Worksheet) As Long    
' This Function finds the last row in a worksheet, and returns the row number

Dim LastCell As Range

With Sht
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), LookAt:=xlPart, LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then
        FindLastRow = LastCell.Row
    Else
        MsgBox "Error! worksheet is empty", vbCritical
        Exit Function
    End If
End With

End Function

---

如果您对较短的解决方案感兴趣。。。。它假定数据从单元格A1开始

---

使用变量数组。更快：@afishance不匹配错误？嗯，我用空电池成功测试了几次。只要数据是连续的，它就可以工作。

Function FindLastRow(Sht As Worksheet) As Long    
' This Function finds the last row in a worksheet, and returns the row number

Dim LastCell As Range

With Sht
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), LookAt:=xlPart, LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then
        FindLastRow = LastCell.Row
    Else
        MsgBox "Error! worksheet is empty", vbCritical
        Exit Function
    End If
End With

End Function

Public Sub CombineColumnData()

    Dim arr As Variant
    Dim newArr() As Variant
    Dim varTemp As Variant
    Dim i As Long

    arr = ActiveSheet.Range("A1").CurrentRegion.Value
    ReDim newArr(1 To UBound(arr, 1))

    For i = LBound(arr, 1) To UBound(arr, 1)
        varTemp = Application.Index(arr, i, 0)
        newArr(i) = Join(varTemp, "")
    Next i

    With ActiveSheet.Range("A1")
        .CurrentRegion.Clear
        .Resize(UBound(arr, 1), 1) = Application.Transpose(newArr)
    End With

End Sub