时间戳

首页 > 解决方案 > 优化复制粘贴

vba - 优化复制粘贴

问题描述

我正在尝试运行超过 80,000 行的大型数据集。如果 C 列包含任何文本，则从第 6 行开始复制一整行。下面是我目前拥有的宏，有什么方法可以优化它以使其不需要这么长时间吗？当前代码逐行运行。

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 新手，所以代码有点基础。任何帮助，将不胜感激

标签： vbaexcel

解决方案

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

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

推荐阅读