在excel中将大数据集中的行组合起来的最佳方式是什么？
一个我拉的报告给了我一个excel电子表格，它将excel中三行的每个条目的数据分开。 我试图找出最好的方法将三行合并成一行，所以每个字段都在它自己的列中。
每三个行群集由一个空行分隔，每个数据行有五个列。 第一个群集从第4行开始。
我有一个macros（如下所示），这是正确的，但效率不高。 我得到的电子表格有很多（最多一百万）行。
我最初使用的是剪切和粘贴命令，而且非常慢。 我发现直接设置.value使它快得多，但这仍然是缓慢的方法。
我认为正确的答案是做内存中的所有操作，只写一次实际的excel范围，但我在我的VBA foo的极限。
Option Explicit Sub CombineRows() Application.ScreenUpdating = False Dim currentRow As Long Dim lastRow As Long Dim pasteColumn As Long Dim dataRange As Range Dim rowEmpty As Boolean Dim firstOfGroup As Boolean Dim data As Variant Dim rw As Range pasteColumn = 6 rowEmpty = True firstOfGroup = True currentRow = 4 lastRow = 30 Set dataRange = Range(Cells(currentRow, 1), Cells(lastRow, 5)) For Each rw In dataRange.Rows Debug.Print rw.Row If WorksheetFunction.CountA(Range(Cells(rw.Row, 1), Cells(rw.Row, 5))) = 0 Then If rowEmpty Then Exit For currentRow = rw.Row + 1 rowEmpty = True Else If Not rowEmpty Then Range(Cells(currentRow, pasteColumn), Cells(currentRow, pasteColumn + 4)).value = Range(Cells(rw.Row, 1), Cells(rw.Row, 5)).value Range(Cells(rw.Row, 1), Cells(rw.Row, 5)).value = "" Debug.Print "pasteColumn:"; pasteColumn If pasteColumn = 6 Then pasteColumn = 11 ElseIf pasteColumn = 11 Then pasteColumn = 6 End If End If rowEmpty = False End If Next Application.ScreenUpdating = True End Sub
更新：我发布后，我注意到，我仍然有那些Debug.Print语句在那里。 一旦我删除了这些，性能从小时数的执行时间改善到一两分钟。
我仍然认为这是不必要的慢，所以我仍然对任何可以解释正确的方式来减lessVBA < – > excel交互的答案感兴趣。
@Cubbi是正确的。 您可以使用一个数组来完成所有的数据操作，然后在最后写入工作表一次 。 我已经调整你的代码来使用一个数组来将三行合并到每个组中。 然后在最后select“Sheet2”并粘贴收集到的数据。 请注意，这不是像你这样的就地解决scheme，但速度非常快：
Option Explicit Sub AutitTrailFormat() Application.ScreenUpdating = False Dim dataArray() As String Dim currentRow As Long Dim lastRow As Long Dim pasteColumn As Long Dim dataRange As Range Dim rowEmpty As Boolean Dim firstOfGroup As Boolean Dim data As Variant Dim rw As Range Dim i, j, k As Long Dim Destination As Range pasteColumn = 6 rowEmpty = True firstOfGroup = True currentRow = 4 lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row Worksheets("Sheet1").Select Set dataRange = Worksheets("Sheet1").Range(Cells(currentRow, 1), Cells(lastRow, 5)) data = dataRange.Value ReDim dataArray(UBound(data, 1), 15) j = 1 k = 1 For i = 1 To UBound(data, 1) If data(i, 1) = "" And data(i, 2) = "" And data(i, 3) = "" And data(i, 4) = "" And data(i, 5) = "" Then j = j + 1 k = 1 Else dataArray(j, k + 0) = data(i, 1) dataArray(j, k + 1) = data(i, 2) dataArray(j, k + 2) = data(i, 3) dataArray(j, k + 3) = data(i, 4) dataArray(j, k + 4) = data(i, 5) k = k + 5 End If Next Worksheets("Sheet2").Select Set Destination = Worksheets("Sheet2").Range(Cells(1, 1), Cells(UBound(dataArray, 1), 16)) Destination.Value = dataArray Application.ScreenUpdating = True End Sub
如果我正确理解你的问题，你想复制一些数据。
我build议你使用一个数组。
Sub data() Dim data() As String 'Create array Dim column as integer column = 0 For i = 0 To 100000 'See how many columns are in the line If IsEmpty(Cells(rowNum, i+1)) = False Then column = column + 1 Else Exit For End If Next ReDim date(column) As String 'Recreat the array, with the excat column numer For i = 0 To column - 1 data(i, j) = Cells(rowNum, i + 1) 'Puts data into the array Next End sub()
现在你只需要将数组中的数据插入正确的单元格。