Question

我目前有2个工作表，为简单起见，在说明中将它们分别称为Sheet1和Sheet2。在Sheet1中，我有大约5万行数据。我试图遍历Sheet1并在数据集中找到唯一的事件，然后转移到Sheet2。

以下是我到目前为止使用的方法及其对所用时间的粗略估计。

方法A-如果满足条件，则使用Sheet1循环遍历For，并在VBA中编程条件检查，如果满足，则将该行上8个单元格的范围传输到Sheet2。此方法在60分钟内完成60％。

方法B-我认为在VBA中删除条件检查可以加快速度，因此我在Sheet1中创建了一个新列，其中带有IF语句，如果满足条件，则返回“ Y”。然后，我遍历此列，如果有“ Y”，则将出现的事件转移到Sheet2。奇怪的是，此方法比方法A花费更长的时间，即60分钟内达到50％。

Sub NewTTS()

Dim lRow1 As Long, lRow2 As Long
Dim i As Long

With wsOTS

    lRow1 = .Range("E" & .Rows.Count).End(xlUp).Row

    For i = lRow1 To 2 Step -1
        If .Range("P" & i).Text = "Y" Then
            lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1

            wsTTS.Range("E" & lRow2, "AA" & lRow2).Value = .Range("E" & i, "AA" & i).Value
        End If
    Next i

End With

End Sub

方法C-然后我在另一篇文章中读到.Find()方法比使用For循环方法更快。因此，我在返回“ Y”的列中使用了.Find()，然后将事件转移到Sheet2中。这是迄今为止最快的方法，但仍只能在60分钟内完成75％。

Sub SearchOTS()

Application.ScreenUpdating = False

Dim startNumber As Long
Dim lRow1 As Long, lRow2 As Long
Dim i As Long
Dim startTime As Double

startTime = Time

lRow1 = wsOTS.Range("E" & wsOTS.Rows.Count).End(xlUp).Row

Columns("P:P").Select

Selection.Find(What:="Y", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Activate

startNumber = ActiveCell.Row

lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1

wsTTS.Range("E" & lRow2, "AA" & lRow2).Value = wsOTS.Range("E" & ActiveCell.Row, "AA" & ActiveCell.Row).Value

For i = 1 To lRow1
    Selection.FindNext(After:=ActiveCell).Activate

    If ActiveCell.Row = startNumber Then GoTo ProcessComplete

    lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1

    wsTTS.Range("E" & lRow2, "AA" & lRow2).Value = wsOTS.Range("E" & ActiveCell.Row, "AA" & ActiveCell.Row).Value

    wsOTS.Range("B18").Value = i / lRow1
Next i

ProcessComplete:

Application.ScreenUpdating = True
MsgBox "Complete! Time taken: " & Format(Time - startTime, "hh:mm:ss")

End Sub

方法D-然后我读了另一篇文章，说最快的方法是建立一个数组，然后遍历该数组。我使用一个集合（动态的）来代替数组，并遍历Sheet1并存储发生的行号。然后，我遍历集合并将事件转移到Sheet2中。此方法在60分钟内返回50％。

Sub PleaseWork()

Dim i As Long
Dim lRow1 As Long, lRow2 As Long
Dim myCol As New Collection

lRow1 = wsOTS.Range("E" & wsOTS.Rows.Count).End(xlUp).Row

'build collection of row numbers
For i = 1 To lRow1
    If wsOTS.Range("P" & i).Text = "Y" Then
        myCol.Add i
    End If
Next i

'now go through collection and build TTS
For i = 1 To myCol.Count
    lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1
    wsTTS.Range("E" & lRow2, "N" & lRow2).Value = wsOTS.Range("E" & myCol(i), "N" & myCol(i)).Value
Next i

Set myCol = New Collection

End Sub

我正在尝试找到最快的方法来完成此任务，但是我尝试过的所有方法都需要一个多小时才能完成。

这里有什么我想念的吗？有没有更快的方法？

Answer 1

访问范围非常慢，这是导致运行时间长的原因。如果您已经知道要读取1000行，则不要一次读取它们。而是将整个范围拉入缓冲区，然后仅使用该缓冲区。写作也一样。如果您事先不知道要写多少，请写一些例如100行长。

（~~未经测试~~）示例：

Sub PleaseWork()

    Dim i As Long, j as long
    Dim lRow1 As Long, lRow2 As Long
    Dim myCol As New Collection
    Dim column_p() as variant
    dim inbuffer() as Variant
    dim outbuffer() as variant

    lRow1 = wsOTS.Range("E" & wsOTS.Rows.Count).End(xlUp).Row
    ' Get whole Column P at once
    column_p = wsOTS.Range("P1").Resize(lRow1, 1).Value

    'build collection of row numbers
    For i = 1 To lRow1
        If column_p(i, 1) = "Y" Then
            myCol.Add i
        End If
    Next i

    'now go through collection and build TTS
    lRow2 = myCol.Count 'Number of required rows
    ' get whole input range
    inbuffer = wsOTS.Range("E1").Resize(lRow1, 10).Value
    ' prepare output
    ReDim outbuffer(1 to lRow2, 1 to 10)
    For i = 1 To myCol.Count
        ' write into outbuffer
        for j = 1 to 10
            outbuffer(i, j) = inbuffer(myCol(i), j)
        Next
    Next i

    ' Set whole output at once
    wsTTS.Range("E1").Resize(lRow2, 10).Value = outbuffer

    Set myCol = New Collection

End Sub

Answer 2

您是否考虑过使用删除重复项。

步骤：

将整个数据复制到新工作表中
在“数据”标签上，选择“删除重复项”

您也可以将其记录为宏。

在工作表之间传输大量数据的最快方法

2 个答案: