Question

我拉的报告给了我一个excel电子表格，它将excel中三行的每个条目的数据分开。我试图找出将三行合并为一行的最佳方法，因此每个字段都在其自己的列中。

每个三行集群由空行分隔，每个数据行有五列。第一个集群从第4行开始。

我有一个宏（如下所示）可以正确地执行此操作，但效率不高。我得到的电子表格中有很多（最多一百万）行。

我最初使用剪切和粘贴命令，而真的慢。我发现直接设置.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语句。一旦我删除了这些，性能就会从执行时间提高到几小时到一两分钟。

我仍然认为这是不必要的慢，所以我仍然对任何可以解释最小化VBA的正确方法的答案感兴趣＆lt; - ＆gt; excel interaction。

Answer 1

如果我理解你的问题，你想要复制一些数据。

我建议你使用数组。

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()

现在你只需要将数组中的数据插入到正确的单元格中。

Answer 2

@Cubbi是对的。您可以使用数组执行所有数据操作，然后在结尾处只写入一次工作表。我已经调整了您的代码以使用数组将三行组合成每个组的单行。然后在最后它选择＆＃34; Sheet2＆＃34;并粘贴在收集的数据中。请注意，这不是像您这样的就地解决方案，但速度非常快：

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

在excel中组合大型数据集中的行的最佳方法是什么

2 个答案: