關于這個問題“垂直和水平組合或合并具有相同值的單元格”鏈接，
提供的答案（編輯過的）它可以作業，但是范圍很大（例如3萬行）宏需要很長時間才能完成（沒有錯誤提出但 excel 沒有回應）。
所以，不是只將第一列放在陣列中，
是否可以將所有內容usedRange移入陣列并處理記憶體上的所有任務，然后復制回作業表？
我根本不關心任何丟失的格式（字體，行高，..）。
在此先感謝您的幫助。
Sub DeleteSimilarRows_AppendLastColuns()
Dim LastRow As Long, ws As Worksheet, arrWork, rngDel As Range, i As Long, j As Long, k As Long
Dim strVal As String, m As Long, boolNoFilter As Boolean
Set ws = ActiveSheet: LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
arrWork = ws.Range("A1:A" & LastRow).Value2 'Place the range in an array to make iteration faster
Application.DisplayAlerts = False: Application.ScreenUpdating = False
For i = 2 To UBound(arrWork) - 1 'Iterate between the array elements:
If arrWork(i, 1) = arrWork(i 1, 1) Then
'Determine how many consecutive similar rows exist:__________________
For k = 1 To LastRow
If i k 1 >= UBound(arrWork) Then Exit For
If arrWork(i, 1) <> arrWork(i k 1, 1) Then Exit For
Next k '___________________________________________
For j = 14 To 14 'Build the concatenated string of cells in range "N":
strVal = ws.Cells(i, j).Value
For m = 1 To k
strVal = strVal & vbLf & ws.Cells(i m, j).Value
Next m
ws.Cells(i, j).Value = strVal: strVal = ""
Next j
For m = 1 To k 'Place the cells for rows to be deleted in a Union range, to delete at the end, at once
If rngDel Is Nothing Then
Set rngDel = ws.Range("A" & i m)
Else
Set rngDel = Union(rngDel, ws.Range("A" & i m))
End If
Next m
i = i k: If i >= UBound(arrWork) - 1 Then Exit For 'Increment the i variable and exiting if the resulted value exits the array size
End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'Delete the not necessary rows
Application.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub
uj5u.com熱心網友回復：
這不僅是可能的，而且是可取的。速度提升是瘋狂的。我就是這樣做的：
電子表格中的資料被保存到 Variant 型別的變數中——結果是一個二維陣列（即使該范圍內只有一行/列）。
' Read data into Array
Dim data as Variant ' Important: has to be type Variant.
Set data = ActiveSheet.UsedRange.Value2 ' .Value or .Value2, as needed
將資料保存回作業表時，此代碼會自動選擇適當大小的范圍。
' Write array into cells
Dim target as Range
Set target = ActiveSheet.Cells(1,1) ' Start at A1 / R1C1; Change as appropriate
target.Resize(UBound(data, 1), UBound(data, 2)).Value = data
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/470795.html