如何使我的代码更快？ （复制列）

Question

我是vba的新手，并编写了以下代码以匹配和复制列；我试图弄清楚如何使其更有效，因为需要花费一些时间来精简输出。任何建议或反馈将不胜感激！我曾想过将屏幕更新切换为false，但这并不能真正加快速度。会因为我使用自动过滤单元格的方法而变慢吗？预先谢谢你。

Sub GetItems()
    Dim cel As Range
    Dim celAddress As Range
    Dim n As Integer
    Dim SelRange As Range
    Dim BrandsPasteLoc As Range

    n = 1

    'Application.ScreenUpdating = False

    Worksheets("CA").Activate
    ActiveSheet.Range("$A$1:$L$2622").AutoFilter Field:=10, Criteria1:="<>#N/A", 
    Criteria2:="<>0", Operator:=xlFilterValues

    Worksheets("Items to push to CA").Activate

    For Each cel In Range("A1:O1")
        Brand = cel.Value
        If Brand = "" Then
            Resume Next
        End If
        Worksheets("CA").Activate
        Application.Workbooks("Items Suggestion_CA").Worksheets("MY").Range("$A$1:$M$3959").AutoFilter Field:=5, Criteria1:=Brand, Operator:=xlFilterValues


        Range("B:B").Sort _
           Key1:=Range("b1"), Order1:=xlDescending     'sorts on Quantity

        Columns("A:A").Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Sheets("Items to push to CA").Select
        Set SelRange = ActiveSheet.Columns(n)
        Set BrandsPasteLoc = Range(Range("A1:Z1").Find(Brand).Offset(1), Range("A1:Z1").Find(Brand).Offset(1).End(xlDown))
        BrandsPasteLoc.Select
        ActiveSheet.Paste
        Worksheets(“CA”).Activate
        n = n + 1
    Next cel

    Worksheets("Items to push to CA").Rows(2).Delete

    Worksheets("Items to push to CA").Activate
    Columns("A:O").Select
    Selection.EntireColumn.AutoFit
    Worksheets("Items to push to CA").Rows(60 & ":" & 
    Sheet1.Rows.Count).ClearContents

    Worksheets("CA").Activate
    Cells.AutoFilter

    Worksheets("Items to push to CA").Activate

    'Application.ScreenUpdating = True
End Sub

Answer 1

.Activate，.Select和AutoFilter非常慢。尝试将您的Range更改为数组并执行操作，并使用一些更智能的搜索算法，然后再复制到目标位置。这样至少可以使速度提高几倍。

Answer 2

这个问题更多地用于Code Review，但尝试在子项开始时添加Application.ScreenUpdating=False，在子项结束时添加Application.ScreenUpdating=True