如何提高VBA宏代碼的速度？

Question

我沒有太多編寫宏的經驗，因此需要此社區的幫助以解決遇到的以下問題：

我的宏將一個工作表中垂直範圍內輸入的值複製一份，然後粘貼這些值在另一個工作表中水平（轉置）。它理論上會將第一張工作表中的值粘貼到第二張工作表中沒有內容的第一行。由於前五行具有內容，所以它將這些值粘貼到第六行。 我在運行宏時遇到的問題是我覺得它太慢了，因此我希望它運行得更快。

我有相同的宏做同樣的事情，但它將值粘貼到另一個工作表到第一行，它運行完美。

因此，我最好的猜測是第二個宏運行緩慢，因爲它必須開始粘貼到第六行，並且前5行中可能有一些內容需要很長時間才能使宏經過（有很多單元格引用其他工作簿）來確定粘貼的下一行應該在哪裏。這是我最好的猜測，因爲我幾乎不知道宏的任何信息，所以我不能確定問題是什麼。

我在此向您提供我的宏的代碼，並真誠地希望有人能告訴我什麼使我的宏變慢，併爲我提供解決方案，以便如何使它運行得更快。我在想，一個解決方案可能可能是宏不應該考慮前五行數據，並立即在第6行開始粘貼第一個條目。然後在第7行，等等。這可能是一個解決方案，但我不知道如何編寫代碼的方式，它會這樣做。

感謝您抽出寶貴時間，幫助我找到一個解決辦法，這裏是代碼：

Sub Macro1() 
Application.ScreenUpdating = False 

    Dim historyWks As Worksheet 
    Dim inputWks As Worksheet 

    Dim nextRow As Long 
    Dim oCol As Long 

    Dim myCopy As Range 
    Dim myTest As Range 

    Dim lRsp As Long 

    Set inputWks = wksPartsDataEntry 
    Set historyWks = Sheet11 

     'cells to copy from Input sheet - some contain formulas 
     Set myCopy = inputWks.Range("OrderEntry2") 

     With historyWks 
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row 
     End With 

     With inputWks 
      Set myTest = myCopy.Offset(0, 2) 

      If Application.Count(myTest) > 0 Then 
       MsgBox "Please fill in all the cells!" 
       Exit Sub 
      End If 
     End With 

     With historyWks 
      With .Cells(nextRow, "A") 
       .Value = Now 
       .NumberFormat = "mm/dd/yyyy hh:mm:ss" 
      End With 
      .Cells(nextRow, "B").Value = Application.UserName 
      oCol = 3 
      myCopy.Copy 
      .Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True 
      Application.CutCopyMode = False 
     End With 

     'clear input cells that contain constants 
     With inputWks 
     On Error Resume Next 
      With myCopy.Cells.SpecialCells(xlCellTypeConstants) 
       .ClearContents 
       Application.GoTo .Cells(1) ', Scroll:=True 
      End With 
     On Error GoTo 0 
     End With 

Application.ScreenUpdating = True 
End Sub 

Answer 1

只是重申已經取得的說：

Option Explicit 

Sub Macro1() 

'turn off as much background processes as possible 
With Excel.Application 
     .ScreenUpdating = False 
     .Calculation = Excel.xlCalculationManual 
     .EnableEvents = False 
End With 

    Dim historyWks As Excel.Worksheet 
    Dim inputWks As Excel.Worksheet 

    Dim nextRow As Long 
    Dim oCol As Long 

    Dim myCopy As Excel.Range 
    Dim myTest As Excel.Range 

    Dim lRsp As Long 

    Set inputWks = wksPartsDataEntry 
    Set historyWks = Sheet11 

     'cells to copy from Input sheet - some contain formulas 
     Set myCopy = inputWks.Range("OrderEntry2") 

     With historyWks 
      nextRow = .Cells(.Rows.Count, 1).End(Excel.xlUp).Offset(1, 0).Row 
     End With 

     With inputWks 
      Set myTest = myCopy.Offset(0, 2) 

      If Excel.Application.Count(myTest) > 0 Then 
       MsgBox "Please fill in all the cells!" 
       GoTo QuickExit 
      End If 
     End With 

     With historyWks 
      With .Cells(nextRow, 1) 
       .Value = Now 
       .NumberFormat = "mm/dd/yyyy hh:mm:ss" 
      End With 
      .Cells(nextRow, 2).Value = Excel.Application.UserName 
      oCol = 3 
      myCopy.Copy 
      .Cells(nextRow, 3).PasteSpecial Paste:=Excel.xlPasteValues, Transpose:=True 
      Excel.Application.CutCopyMode = False 
     End With 

     'clear input cells that contain constants 
     With inputWks 
     On Error Resume Next 
      With myCopy.Cells.SpecialCells(Excel.xlCellTypeConstants) 
       .ClearContents 
       Excel.Application.Goto .Cells(1) ', Scroll:=True 
      End With 
     On Error GoTo 0 
     End With 

    Calculate 

QuickExit 

With Excel.Application 
     .ScreenUpdating = True 
     .Calculation = Excel.xlAutomatic 
     .EnableEvents = True 
End With 

End Sub 

我會步宏行由行，試圖找出哪條線路是緩慢的。

另一種選擇 - 雖然不知道這是否會加快東西 - 是爲了避免剪貼板，並失去了copy/paste所以你最好申請一個方法像下面來移動數據：

Option Explicit 

Sub WithoutPastespecial() 

'WORKING EXAMPLE 

Dim firstRange As Range 
Dim secondRange As Range 

Set firstRange = ThisWorkbook.Worksheets("Cut Sheet").Range("S4:S2000") 
With ThisWorkbook.Worksheets("Cutsheets") 
    Set secondRange = .Range("A" & .Rows.Count).End(Excel.xlUp).Offset(1) 
End With 

With firstRange 
     Set secondRange = secondRange.Resize(.Rows.Count, .Columns.Count) 
End With 
secondRange.Value = firstRange.Value 

End Sub 

Answer 2

請看看這篇文章也是如此。 How to speed up calculation and improve performance...

無論如何，Application.calculation = xlCalculationManual通常是罪魁禍首。但是我們可以注意到，易變的Excel工作表函數通常會在大規模的數據處理和功能方面殺死您的應用程序。

另外，對於您當前的代碼，以下文章可能不直接相關。我發現它適用於所有Excel/VBA性能優化的提示。

75 Excel speeding up tips

PS：我沒有足夠的聲譽在您的文章發表評論。所以添加爲答案。

Answer 3

正如評論中的一些其他人所建議的，您應該將Application.Calculation更改爲xlCalculationManual並記住最後將其設置回xlcalculationAutomatic。另外嘗試設置Application.Screenupdating = False（並再次打開它）。另外，請記住.Copy是複製單元格值的非常低效的方法 - 如果您真的只需要這些值，請循環範圍設置.Value到舊範圍內的.Values。如果你需要所有的格式，你可能會停留在.Copy。

關閉計算/屏幕刷新標誌時，請記住在任何情況下（即使程序在不同點退出或導致運行時錯誤）都將其重新打開。否則會發生各種不好的事情。:)

Answer 4

剛幾點建議（會張貼評論，但我想我沒有代表）：

1. 嘗試指的細胞，而不是命名範圍地址（懷疑這將是原因，但可能會造成一些打到性能）

2. 您的工作簿公式是否包含指向其他工作簿的鏈接？嘗試在具有損壞的鏈接的文件上測試代碼以查看它是否可以提高性能。

3. 如果這些都不是問題，我的猜測是如果公式過於複雜，可能會增加一些處理開銷。嘗試僅包含值的文件上的代碼，以查看是否有任何改進的性能。

Answer 5

根據我的經驗，提高性能的最佳方法是在代碼中處理變量，而不是每次要查找值時訪問電子表格。 將想要使用的任何範圍保存在變量（變體）中，然後遍歷它，就好像它是表單一樣。有很多很多更快的讀取速度數據（行，列） -

dim maxRows as double 
    dim maxCols as integer. 
    dim data as variant 
with someSheet 
    maxRows = .Cells(rows.count, 1).end(xlUp).row    'Max rows in sheet 
    maxCols = .Cells(1, columns.count).end(xlToLeft).column 'max columns in sheet 
    data = .Range(.Cells(1,1), .Cells(maxRows, maxCols))  'copy range in a variable 
end with 

從這裏你可以訪問數據的變量，如果它是像電子表格。

Answer 6

您可以通過在更改單元格值期間停止計算並在此之後啓用它來提高速度。請點擊鏈接。 http://webtech-training.blogspot.in/2013/10/how-to-stop-heavy-formula-calculation.html

Answer 7

.Cells（nextRow，3）.PasteSpecial粘貼：= xlPasteValues，移調：=真 Application.CutCopyMode =假

我不會那麼做的。剪切，複製&粘貼操作是操作系統中處理器利用率最高的操作。

相反，你可以只從一個單元格/範圍到另一個單元格/範圍，指定值作爲

Cells(1,1) = Cells(1,2) or Range("A1") = Range("B1") 

希望你有我的觀點..