优化Excel VBA拷贝/粘贴宏的读写速度

Question

我有一个Excel表，它连接到第三方软件，用数据填充Sheet1。它每秒多次执行此操作，并覆盖以前的数据。

我编写了下面的宏，以便在每次更改Sheet1时将数据复制并粘贴到工作表(称为数据)中。

该宏的前一个版本缩小了一个范围，一次复制一行，这花费了(相对)很长的时间，因为数据集中可能有50000+行。

当前版本使用的是变体数组，但似乎仍然非常缺乏资源。

还有其他方法可以优化它使它更有效率吗？

谢谢

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Columns.Count <> 16 Then Exit Sub
             
    'Count the cells to copy
    Dim a As Integer
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        inarr = .Range(.Cells(1, 1), .Cells(lastRow + 5, 26)) ' load all of sheet 1 data in a variant array
    End With
    a = lastRow
    'Count the last cell where to start copying
    Dim b As Long
    
    With ThisWorkbook.Worksheets("Data")
        b = .Cells(Rows.Count, "A").End(xlUp).Row
            
        Dim c As Integer
        c = 5
        'Perform the copy paste process
        Dim outarr() As Variant
        ReDim outarr(1 To a, 1 To 22)
        Application.EnableEvents = False
        For i = 1 To a - 1
        
            If ThisWorkbook.Worksheets("Sheet1").Range("E2") <> "" And ThisWorkbook.Worksheets("Sheet1").Range("F2") = "" And ThisWorkbook.Worksheets("Sheet1").Range("AB5") = "35" Then
                outarr(i, 1) = inarr(3, 14)
                outarr(i, 2) = inarr(2, 2)
                outarr(i, 3) = inarr(1, 1)
                outarr(i, 4) = inarr(2, 5)
                outarr(i, 5) = inarr(c, 26)
                outarr(i, 6) = inarr(c, 1)
                outarr(i, 7) = inarr(c, 6)
                outarr(i, 8) = inarr(c, 8)
                outarr(i, 9) = inarr(c, 15)
                outarr(i, 10) = inarr(c, 16)
                outarr(i, 11) = inarr(3, 2)
                outarr(i, 12) = inarr(c, 7)
                outarr(i, 13) = inarr(c, 2)
                outarr(i, 14) = inarr(c, 3)
                outarr(i, 15) = inarr(c, 4)
                outarr(i, 16) = inarr(c, 5)
                outarr(i, 17) = inarr(c, 9)
                outarr(i, 18) = inarr(c, 12)
                outarr(i, 19) = inarr(c, 13)
                outarr(i, 20) = inarr(c, 10)
                outarr(i, 21) = inarr(c, 11)
                outarr(i, 22) = inarr(c, 25)
                
                c = c + 1
            End If
        Next i
        ThisWorkbook.Worksheets("Data").Range(.Cells(b + 1, 1), .Cells(b + a - 4, 22)) = outarr
    End With
    Application.EnableEvents = True

    'End If


    Dim lastcell As Range
    Dim wsStore As Worksheet
    
    Set wsStore = ThisWorkbook.Worksheets("Store")
    
    Set lastcell = wsStore.Cells(wsStore.Rows.Count, 1).End(xlUp)
    
    With ThisWorkbook.Worksheets("Sheet1").Range("F2")
're-set F2 when last cell of the Store sheet is no longer the same as the value in N3
        If .Value = "Closed" And Val(.ID) <> xlOff Then
            .ID = xlOff
                
            Call CopyToStore
            Call ClearData
        
        ElseIf .Offset(1, 8).Value <> lastcell.Value Then
            .ID = xlOn
        End If
    End With

End Sub

Answer 1

选项显式

(最佳实践)始终在模块顶部声明Option Explicit。这允许编译器标记未显式声明的变量的使用。这有助于发现很难发现的bugs -特别是那些由于打字而造成的错误。使其自动化:在VBIDE中，检查'Tools -> Options. -> (编辑器选项卡) 'Require automatic‘选项。FWIW:为已发布的代码声明它找到了3个未声明的变量。

优化

优化循环时，第一步是删除在循环中不一定要执行的所有内容。

如前所述声明..。

If ThisWorkbook.Worksheets("Sheet1").Range("E2") <> "" And ThisWorkbook.Worksheets("Sheet1").Range("F2") = "" And ThisWorkbook.Worksheets("Sheet1").Range("AB5") = "35" Then

为i...but的每个值执行表达式的位置，表达式的结果不依赖于i。因此，该语句(当前取消引用ThisWorkbook.Worksheets("Data") 3 (x 50000+)次数)可以移出循环之外，只执行一次。按照以下方式组织代码，可以消除效率低下的问题：

        Dim copyArrayElements As Boolean
        With ThisWorkbook.Worksheets("Sheet1")
            copyArrayElements = .Range("E2") <> "" And .Range("F2") = "" And .Range("AB5") = "35"
        End With

        If copyArrayElements Then

            For i = 1 To a - 1
                outarr(i, 1) = inarr(3, 14)

                '...the rest of the assignments

                outarr(i, 22) = inarr(c, 25)

                c = c + 1
            Next i
        End If

应用程序标志

在子例程中，Application.EnableEvents设置为False，然后重置为True。重要的是要可靠地重置此标志。但是，在重置错误之前可能会发生错误。确保始终重置此标志的最简单的更改是将错误处理添加到子例程中。比如：

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Columns.Count <> 16 Then Exit Sub
    
On Error GoTo ErrorExit
    '... the rest of the subroutine...
    
ErrorExit:
    Application.EnableEvents = True
    'Any other code that HAS to execute in the event of an error
End Sub

即使'Application.EnableEvents‘在函数结束前被设置为True (当没有错误(S))，在错误处理程序中再次设置它也没有坏处。

大“With”块

With语句可以使代码更容易阅读，并且在某些情况下执行得更快一些。但是，如果With和End With之间有很多代码行，那么很容易忘记在With语句中使用什么对象。这似乎发生在这里：

    Dim b As Long

    With ThisWorkbook.Worksheets("Data")
        b = .Cells(Rows.Count, "A").End(xlUp).Row

    '... the rest of code within the With block
    
        ThisWorkbook.Worksheets("Data").Range(.Cells(b + 1, 1), .Cells(b + a - 4, 22)) = outarr
    End With

With块中的最后一条语句应该是.Range(.Cells(b + 1, 1), .Cells(b + a - 4, 22)) = outarr。在With块的开始和结束之间有这么多行内容，因此很容易失去With块的用途。而且，据我所知，只有另外一种用法。操作员(b = .Cells(Rows.Count, "A").End(xlUp).Row)。在这种情况下，如果删除这个With块，代码将不会运行得更慢。但是，理解代码的认知努力肯定会减少。

验证

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Columns.Count <> 16 Then Exit Sub

上面的语句验证Target参数。除了16列的目标Range之外，其他任何内容都不值得执行后续代码。而且，看起来可能还有其他的标准。上面声明和设置变量copyArrayElements的代码示例看起来像是在子例程顶部执行的候选代码。如果copyArrayElements是False，那么执行其余的代码有意义吗？

所以也许..。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Columns.Count <> 16 Then Exit Sub

    Dim copyArrayElements As Boolean
    With ThisWorkbook.Worksheets("Sheet1")
        copyArrayElements = .Range("E2") <> "" And .Range("F2") = "" And .Range("AB5") = "35"
    End With

    If Not copyArrayElements Then Exit Sub

也是适当的上下文验证标准。