如何提高VBAmacros代码的速度？

我没有太多编写macros的经验，因此遇到以下问题需要本社区的帮助：

我的macros复制一个工作表中垂直范围内input值的范围，然后水平粘贴（转置）在另一个工作表中的值。 理论上，将第一张表格中的值粘贴到第二张表格中没有内容的第一行。 由于前五行具有内容，因此将值粘贴到第六行。 我在运行macros的时候遇到的问题是，我觉得它太慢了，所以我希望它运行得更快。

我有相同的macros做同样的事情，但是将值粘贴到另一个工作表到第一行，它运行完美。

因此，我最好的猜测是第二个macros运行缓慢，因为它必须在第六行开始粘贴，前5行中可能有一些内容需要花费大量的时间来处理macros（有很多单元格引用其他工作簿）来确定粘贴的下一行应该在哪里。 这是我最好的猜测，因为我几乎不知道macros，所以我不能确定问题是什么。

我在此向您提供我的macros的代码，并真诚地希望有人能告诉我什么是使我的macros慢，并提供了一个解决scheme，如何使其运行更快。 我在想，一个解决scheme可能是macros不应该考虑前五行的数据，并立即开始粘贴第6行第一个条目。 然后在第7行，等等。这可能是一个解决scheme，但我不知道如何编写代码的方式，它会这样做。

感谢您花时间帮助我find一个解决scheme，这里是代码：

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 

我会逐行通过macros来尝试找出哪一行很慢。

另一个select – 虽然不知道是否会加快速度 – 是避免剪贴板，并丢失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

根据我的经验，提高性能的最佳方法是在代码中处理variables，而不是每次要查找值时访问电子表格。 将想要使用的任何范围保存在一个variables（变体）中，然后遍历它，就好像它是表单一样。

  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 

从这里你可以访问数据variables，就好像它是电子表格一样 – 数据（行，列），读取速度快得多。

Answer 3

请看看这篇文章。 如何加速计算和提高性能…

通过一切手段，Application.calculation = xlCalculationManual通常是罪魁祸首。 但是我们可以注意到，易变的Excel工作表函数大多会在大规模的数据处理和function方面扼杀你的应用程序。

另外，对于您当前的代码后续可能不直接相关。 我发现它对于全面的Excel / VBA性能优化提示很有用。

Excel加速提示

PS：我没有足够的声望评论你的post。 所以添加为答案..

Answer 4

正如评论中的其他一些人所build议的那样，您应该将Application.Calculation更改为xlCalculationManual，并记住最后将其设置回xlcalculationAutomatic。 另外尝试设置Application.Screenupdating = False（并再次打开它）。 另外，请记住.Copy是复制单元格值的非常低效的方法 – 如果您真的只想要值，请循环范围设置.Value到旧范围内的.Values。 如果你需要所有的格式，你可能会坚持使用.Copy。

当closures计算/屏幕刷新标志时，请记住在任何情况下（即使您的程序在不同的点退出或导致运行时错误）都将其重新打开。 否则会发生各种不好的事情。 🙂

Answer 5

只是一些build议（将张贴作为评论，但我想我没有代表）：

1. 尝试引用单元格地址，而不是命名的范围（怀疑这将是原因，但可能会导致一些命中的performance）

2. 您的工作簿公式是否包含指向其他工作簿的链接？ 尝试使用损坏的链接testing文件上的代码，以查看它是否改善了性能。

3. 如果这两个都不是问题，那么我的猜测是，如果公式过于复杂，可能会增加一些处理开销。 尝试仅包含值的文件上的代码，以查看是否有任何改进的性能。

Answer 6

您可以通过在更改单元格值期间停止计算来提高速度，然后可以启用它。 请点击链接。 http://webtech-training.blogspot.in/2013/10/how-to-stop-heavy-formula-calculation.html

Answer 7

.Cells（nextRow，3）.PasteSpecial Paste：= xlPasteValues，Transpose：= True Application.CutCopyMode = False

我不会这样做的。 就操作系统中的处理器利用率而言，剪切，复制和粘贴操作是成本最高的操作。

相反，您可以将值从一个单元格/范围分配给另一个单元格/范围，如下所示

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

希望你有我的观点..