如何提高VBA宏代码的速度？ [英] How to improve the speed of VBA macro code?

问题描述

我在编写宏时没有太多的经验，因此需要此社区的帮助才能遇到以下问题：

I do not have much experience with writing macros, and therefore need the help of this community for the following issue encountered:

我的宏复制输入的一系列值在一个工作表中的垂直范围内，然后将值水平（转置）粘贴到另一个工作表中。它将理论上将第一个工作表中的值粘贴到没有内容的第二个工作表的第一行。由于前五行具有内容，因此将值粘贴到第六行。
我与宏的运行有关的问题是我觉得这太慢了，所以我希望运行速度更快。

My macro copies a range of values entered in a vertical range in one worksheet and then pastes the values horizontally (transpose) in another worksheet. It would in theory paste the values from the first sheet to first row of the second worksheet which does not have content. Since the first five rows have contents, it thus pastes the values to the sixth row. The problem I have with the running of the macro is that I feel like it is too slow and I would therefore like it to run faster.

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

I have the same macro doing the same thing but that instead pastes the values to another worksheet to the first row, and it runs perfect.

因此，我最好的猜测是第二个宏运行缓慢，因为它必须开始粘贴在第六行，并且可能在前5行中有一些内容很多时间让宏经历（有很多单元格引用到其他工作簿），以确定下一行粘贴应该在哪里。这是我最好的猜测，因为我几乎不了解宏的任何事情，我不能确定问题是什么。

My best guess is therefore that the second macro is running slow because it has to start pasting on the sixth row and there may be some contents on the first 5 rows that take a lot of time for the macro to go through (there a lot of cell references to other workbooks) to determine where the next row for pasting should be. That is my best guess though and since I hardly know anything about macros, I cannot say for sure what the problem is.

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

I hereby provide you with the code of my macro and sincerely hope that somebody can tell me what is making my macro slow and provide me with a solution as to how to make it run faster. I am thinking that a solution might potentially be that the macro should not consider the first five rows of data and start pasting immediately on row 6 for the first entry. Then on row 7 the next time, and etc. This might be a solution but I do not know how to write the code in a way that it would do that.

感谢您抽出时间并帮助我找到解决方案，以下是代码：

Thank you for taking time and helping me to find a solution, here is the code:

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

推荐答案

只是重申已经说过的内容：

Just reiterating what has already been said:

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

我将一步一步地浏览宏，尝试找出哪条线慢。

I'd step through the macro line-by-line to try to locate which line is slow.

另一个选择 - 虽然不知道是否加快速度 - 是避免剪贴板，并丢失复制/粘贴，以便您应用一个类似以下的方法来移动数据：

Another alternative - although not sure if it'll speed things up - is to avoid the clipboard and lose the copy/paste so you'd apply a method like the following to move the data:

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

这篇关于如何提高VBA宏代码的速度？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！