如何加快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和Last Column和使用范围。 UsedRange可能不是您认为它的范围:)。你可能想看到THIS的解释。

见这个例子（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