Question

我正在尝试遍历超过80,000行的大型数据集。如果C列包含从第6行开始的任何文本，则复制整行。下面是我目前拥有的Macro，是否有任何方法可以对其进行优化，以免花费很长时间？当前代码逐行运行。

Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 100000
pasteRowIndex = 1
For r = 6 To endRow 'Loop through Stocks to Sell and search for your criteria

If Cells(r, Columns("C").Column).Value <> Empty Then
        'Copy the current row
             Rows(r).Select
             Selection.Copy
        'Switch to the sheet where you want to paste it & paste
             Sheets("Stocks to Sell").Select
             ActiveSheet.Rows(pasteRowIndex).Select
             Selection.PasteSpecial Paste:=xlPasteValues
        'Next time you find a match, it will be pasted in a new row
             pasteRowIndex = pasteRowIndex + 1
        'Switch back to your table & continue to search for your criteria
             Sheets("Unrealized Gains Report").Select
End If
If Cells(r, Columns("D").Column).Value = "yes" Then 'Found
        'Copy the current row
             Rows(r).Select
             Selection.Copy
        'Switch to the sheet where you want to paste it & paste
             Sheets("Gmma Positions").Select
             ActiveSheet.Rows(pasteRowIndex).Select
             Selection.PasteSpecial Paste:=xlPasteValues
        'Next time you find a match, it will be pasted in a new row
             pasteRowIndex = pasteRowIndex + 1
        'Switch back to your table & continue to search for your criteria
             Sheets("Unrealized Gains Report").Select
End If
Next r
End Sub

我是VBA的新手，所以代码有些基础。任何帮助将不胜感激

Answer 1

您可以进行两项重大改进：

1）。在过程开始时禁用计算，屏幕更新和警报。然后在最后重新启用它们。

2）。摆脱激活和选择所有内容的习惯。在大多数情况下，这是完全不必要的，并且会大大降低操作速度。

相反，尝试这样（代码注释中的其他注释/解释）：

Sub testIt()

    ' Disable visual and calc functions
    ' So Excel isn't updating the display and
    ' recalculating formulas every time you
    ' fill another cell
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual



    Dim r As Long
    Dim endRow As Long
    endRow = 100000

    ' I think you actually need separate pastRowIndexes for each target sheet
    Dim pasteRowIndexGmma As Long
    pasteRowIndexGmma = 1

    Dim pasteRowIndexStocks As Long
    pasteRowIndexStocks = 1

    ' Create & set variables for referencing worksheets
    ' These will be used instead of Activating and Selecting the
    ' source and target worksheets, which should speed up operation
    Dim wsStocks As Worksheet
    Set wsStocks = ThisWorkbook.Worksheets("Stocks to Sell")
    Dim wsUnrealized As Worksheet
    Set wsUnrealized = ThisWorkbook.Worksheets("Unrealized Gains Report")
    Dim wsGmma As Worksheet
    Set wsGmma = ThisWorkbook.Worksheets("Gmma Positions")

    For r = 6 To endRow 'Loop through Stocks to Sell and search for your criteria

        If wsUnrealized.Cells(r, Columns("C").Column).Value <> Empty Then

            ' You do not need to keep activating and selecting everything
            ' Just use the worksheet variables to target the correct sheet
            ' No selections necessary

            'Copy the current row
            wsUnrealized.Rows(r).Copy

            'Switch to the sheet where you want to paste it & paste
            wsStocks.Rows(pasteRowIndexStocks).PasteSpecial Paste:=xlPasteValues

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndexStocks = pasteRowIndexStocks + 1

        End If
        If wsUnrealized.Cells(r, Columns("D").Column).Value = "yes" Then 'Found
            'Copy the current row
            wsUnrealized.Rows(r).Copy

            'Switch to the sheet where you want to paste it & paste
            wsGmma.Rows(pasteRowIndexGmma).PasteSpecial Paste:=xlPasteValues

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndexGmma = pasteRowIndexGmma + 1

        End If

    Next r


    ' Re-Enable visual and calc functions
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic


End Sub

优化复制和粘贴

1 个答案: