縮短復制和粘貼 VBA 以將過濾的單元格從一張紙粘貼到另一張紙上

Question

我對 VBA 很陌生，想在下面提供一些建議，我目前正在嘗試過濾某些日期，然后將它們復制並粘貼到單獨的工作表中，然后 =SUBTOTAL 等。 VBA 可以工作，但確實需要比預期稍長的時間。 誰能給我提供一個解決方案，我已經用谷歌搜索了這個，並且在縮短時無法讓它工作。

Sheets("Paster").Select
ActiveSheet.Range("$A$1:$AK$801").AutoFilter Field:=10, Criteria1:= _
    xlFilterLastYear, Operator:=xlFilterDynamic
Cells.Select
Selection.Copy
Sheets("Hidden").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Overall").Select

Answer 1

使用 select 非常慢，如果你能幫助它，通常可以避免使用。 我建議使用 with 語句在給定的工作表上執行所有操作。 這樣的事情應該有所幫助。 不要使用選擇，而是嘗試激活。

With Sheets("Paster").Range("$A$1:$AK$801")
    .AutoFilter Field:=10, Criteria1:= _
    xlFilterLastYear, Operator:=xlFilterDynamic
    .Copy
End With

With Sheets("Hidden")
    .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ 
        SkipBlanks:=False, Transpose:=False 'I just pasted into cell A1
End With
Sheets("Overall").Activate

我希望這樣的事情會有所幫助！ 我不知道您使用的是什么類型的數據，但它確實將一堆隨機生成的數據復制到隱藏工作表中。

為避免屏幕閃爍/閃爍，您可以做的另一件事是在宏開始時關閉屏幕更新，然后在結束時將其重新打開。

Application.ScreenUpdating = False ' This should be the first line of a sub
Application.ScreenUpdating = True  ' This should be the last line of the sub

Answer 2

每當你使用.Copy .Paste或.Select它的顯著放慢你失望。 您可以通過關閉屏幕更新和計算來稍微加快速度。 然后使用范圍本身總是會更快，請參閱下文，了解我如何擺脫使用.Select您可以在此處閱讀有關它的更多信息。 通常，當您想跳過使用.copy ，最好對This Range = That Range說，然后您可以完全跳過剪貼板，但對於過濾的數據，這有點像一場噩夢。

Sub CopyAndPaste()

    Dim wbk As Workbook
    Dim Paste As Worksheet, Hidden As Worksheet, Overall As Worksheet

    Set wbk = ActiveWorkbook
    Set Paste = wbk.Worksheets("Paster")
    Set Hidden = wbk.Worksheets("Hidden")
    Set Overall = wbk.Worksheets("Overall")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

        Paste.Range("$A$1:$AK$801").AutoFilter Field:=10, Criteria1:=xlFilterLastYear, Operator:=xlFilterDynamic
        Paste.Cells.Copy

        Hidden.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub