Question

我正在使用本教程编写VBA循环来搜索列中的值，并使用条件值拉取所有行。

https://www.youtube.com/watch?v=QOxhRSCfHaw

它正在运行，但它需要大约5分钟才能运行，最后我只得到1个结果（行），当我应该得到数千个。

Sub finddata()

'1.Declare Variables
'2.Find Records that match criteria and paste them into new worksheet

Dim customcode As String
Dim finalrow As Long
Dim i As Long

customcode = Sheets("Sheet2").Range("A1").Value
finalrow = Sheets("Raw Data").Range("A252800").End(xlUp).Row

For i = 1 To finalrow

If Cells(i, 46) = customcode Then
Range(Cells(i, 1), Cells(i, 102)).Copy
Worksheets("Sheet1").Range("A1").PasteSpecial 
End If

Next i

End Sub

非常感谢任何帮助。

Answer 1

尝试一个阵列。

Sub finddate()

Dim dataRng As Range
Dim origData, newData
Dim i As Long, j As Long, k As Long
Dim customcode As String

customcode = Sheets("Sheet2").Range("A1").Value

With ThisWorkbook.Worksheets("Raw Data")
    Set dataRng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 102).End(xlUp))
End With

origData = dataRng.Value
ReDim newData(1 To UBound(origData, 1), 1 To UBound(origData, 2))

j = 1
For i = 1 To UBound(origData, 1)
    If origData(i, 46) = customcode Then
        For k = 1 To UBound(origData, 2)
            newData(j, k) = origData(i, k)
        Next
        j = j + 1
    End If
Next

With ThisWorkbook.Worksheets("Sheet1")
    .Range(.Cells(1, 1), .Cells(j, 102)) = newData
End With

End Sub

VBA循环 - 仅1个结果

1 个答案: