如何加速Excel VB宏

Question

我正在尝试加速Excel VB宏。 我已经尝试了以下5种选择。 但是我想知道是否可以进一步缩短执行时间。 我在用户博客中找到了2种无法使用的替代方法。 在用户博客中也找到了一种替代方法，但并不了解。

Sub AccelerateMacro()

'
' v1 052817 by eb+mb
' Macro to copy as fast as possible sheet from one workbook into another workbooks
' Declarations for variables are not shown to make code example more legible
' Macro is stored in and run from "DestinationWorkBook.xlsm"

StartTime = Timer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Alternative = "First"

If Alternative = "First" Then
    Workbooks.Open Filename:="SourceWorkBook.xls"
    Cells.Select
    Selection.Copy
    Windows("DestinationWorkBook.xlsm").Activate
    Sheets("DestinationSheet").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("SourceWorkBook.xls").Activate
    ActiveWorkbook.Close
End If

If Alternative = "Second" Then
    Workbooks.Open Filename:="SourceWorkBook.xls", ReadOnly:=True
    Cells.Select
    Selection.Copy
    Windows("DestinationWorkBook.xlsm").Activate
    Sheets("DestinationSheet").Select
    Range("A1").Select
    ActiveSheet.Paste
    Workbooks("SourceWorkBook.xls").Close SaveChanges:=False
End If

If Alternative = "Third" Then
' I could not get this alternative to work
    Workbooks.Open("SourceWorkBook.xls").Worksheets("SourceSheet").Copy
    Workbooks.Open("DestinationWorkBook.xlsm").Worksheets("DestinationSheet").Range("A1").PasteSpecial
End If

If Alternative = "Fourth" Then
' I could not get this alternative to work
    Workbooks.Open("DestinationWorkBook.xlsm").Worksheets("DestinationSheet").Range("A1") = Workbooks.Open("SourceWorkBook.xls").Worksheets("SourceSheet")
End If

If Alternative = "Fifth" Then
' I don't understand the code in this alternative
    Dim wbIn As Workbook
    Dim wbOut As Workbook
    Dim rSource As Range
    Dim rDest As Range
    Set wbOut = Application.Workbooks.Open("DestinationWorkBook.xlsm")
    Set wbIn = Application.Workbooks.Open("SourceWorkBook.xls")
    With wbIn.Sheets("SourceSheet").UsedRange
    wbOut.Sheets("DestinationSheet").Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
End With


SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

Answer 1

代替使用UsedRange ，找到实际的“ Last Row UsedRange和“ Last Column并使用该范围。 UsedRange可能不是您认为的范围：)。 您可能需要查看此说明。

看到这个例子（ UNTESTED ）

Sub Sample()
    Dim wbIn As Workbook, wbOut As Workbook
    Dim rSource As Range
    Dim lRow As Long, LCol As Long
    Dim LastCol As String

    Set wbOut = Workbooks.Open("DestinationWorkBook.xlsm")
    Set wbIn = Workbooks.Open("SourceWorkBook.xls")

    With wbIn.Sheets("SourceSheet")
        '~~> Find Last Row
        lRow = .Cells.Find(What:="*", _
                After:=.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

        '~~> Find Last Column
        LCol = .Cells.Find(What:="*", _
                After:=.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

        '~~> Column Number to Column Name
        LastCol = Split(Cells(, LCol).Address, "$")(1)

        '~~> This is the range you want
        Set rSource = .Range("A1:" & LastCol & lRow)

        '~~> Get the values across
        wbOut.Sheets("DestinationSheet").Range("A1:" & LastCol & lRow).Value = _
        rSource.Value
    End With
End Sub