Efficient way to concatenate two cells-CodePudding

Currently, the below code combined the "top" and "bottom" cell and sets the value of the "bottom" cell as the combined value. Iterating through thousands of columns, it's slower than I thought.

Dim wb As Workbook
Dim ws As Worksheet
Dim topCell As String, bottomCell As String, combinedCell As String

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")

For i = 1 To 10000
    topCell = ws.Cells(1,i).Value
    bottomCell = ws.Cells(2,i).Value
    bottomCell = Format(bottomCell, "yyyy")
    combinedCell = topCell & " " & bottomCell
Next i

ws.Rows(1).EntireRow.ClearContents

Is there a more efficient way to go about this?

CodePudding user response：

To speed up VBA, you need to reduces the access from VBA to Excel because that is what makes your code slow. Read all data at once into a (2-dimensional) array, loop over that array and then write back the array.

Dim r As Range, data As Variant, col As Long
' Set Range and read values into Array
With ThisWorkbook.Sheets(1)
    Set r = .Range(.Cells(1, 1), .Cells(2, 10000))
End With
data = r.Value
' Process data
For col = LBound(data, 2) To UBound(data, 2)
    data(2, col) = data(1, col) & Format(data(2, col), "yyyy")
    data(1, col) = ""
Next
' Write back
r.Value = data

CodePudding user response：

Concat Rows in 10k Columns (`Evaluate`)

Option Explicit

Sub ConcatRows()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    
    With ws.Range("A1:NTP2")
        .Rows(2).Value = ws.Evaluate(.Rows(1).Address _
            & "&"" ""&" & "TEXT(" & .Rows(2).Address & ",""yyyy"")")
        .Rows(1).ClearContents
    End With

End Sub

Barely Related (Bonus?)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the Excel column string from a (column) number.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnString( _
    ByVal ColumnNumber As Long) _
As String
    Dim Remainder As Long
    Do
        Remainder = (ColumnNumber - 1) Mod 26
        GetColumnString = Chr(Remainder   65) & GetColumnString
        ColumnNumber = Int((ColumnNumber - Remainder) \ 26)
    Loop Until ColumnNumber = 0
End Function


Sub GetColumnStringTESTandHelp()
    Debug.Print GetColumnString(10000) ' result 'NTP'
    Range("NTP1").Select
    Range("A1:NTP1").EntireColumn.AutoFit
End Sub

Concat Rows in 10k Columns (Evaluate)

Concat Rows in 10k Columns (`Evaluate`)