Question

我在VBA上有一个模块，它基本上为每个包含列中文本的单元格运行一个foreach循环。然后将每个单元格的内容复制到调用另一个函数的另一个工作表（DailyGet）。从函数生成的内容被复制回原始工作表（我通过记录宏来生成代码）。但是，由于在foreach循环中有许多单元要处理，所以它非常耗时，因为宏每次都在工作表之间切换。有没有办法加快这个过程？

*   *      
  * *      
*  *  ** *  *  
    *  *   
    *    *

Answer 1

首先，您可以摆脱所有选择

        Range("D3:Z3").Select
        Application.CutCopyMode = False
        Selection.copy
        Sheets("Summary").Select
        cel.Offset(0, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

应该是：

   Sheets("Calculations").Range("D3:Z3").Copy
   cel.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

其次，为什么必须在运行DailyGet之前切换到Calculations表。如果函数dailyGet使用ActiveSheet，请将其更改为Sheets（＆＃34; Calculations＆＃34;）。如果你这样做，你永远不需要换页。

第三步，启动宏时关闭ScreenUpdating，完成后重新打开：

Application.ScreenUpdating = False

Answer 2

一般来说，你应该总是避免选择。而是尝试并声明/实例化您的变量，如图所示。我已经评论了下面的代码来解释发生了什么。如果您有任何问题，请告诉我。

    Option Explicit 'Always use this it helps prevent simple errors like misspelling a variable

Sub DailyComposite()
'Declare all variables you are going to use
Dim wb As Workbook 'The workbook youa re working with
Dim wsCalc As Worksheet 'Calculations sheet
Dim wsSum As Worksheet 'Summary Sheet
Dim SrchRng As Range, cel As Range

'Instantiate your variables
Set wb = ThisWorkbook
Set wsCalc = wb.Worksheets("Calculations")  'now you can simply use the variable to refer to the sheet NO SELECTING
Set wsSum = wb.Worksheets("Summary") 'SAME AS ABOVE
Set SrchRng = Range("B2:B100")

Application.ScreenUpdating = False  'Turn this off to speed up your macro
For Each cel In SrchRng
    If cel.Value <> "" Then
        'This ... Worksheets("Calculations").Range("B1").Value = cel.Value becomes...
        wsCalc.Range("B1").Value = cel.Value
        'Sheets("Calculations").Select ... this line can be deleted
            Call DailyGet

            'Range("D3:Z3").Select
            'Application.CutCopyMode = False
            'Selection.Copy
            'Sheets("Summary").Select
            'cel.Offset(0, 1).Select
        'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
         '   xlNone, SkipBlanks:=False, Transpose:=False
         'All of the above can be replaced by...
        wsCalc.Range("D3:Z3").Copy
        cel.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End If
Next cel
'You can keep these if you truly want to select the A1 cell at the end
    'Sheets("Calculations").Select
    wsCalc.Activate
    Range("A1").Select
    'Sheets("Summary").Select

    wsSum.Activate
    Range("A1").Select
Application.ScreenUpdating = True 'Turn it back on
End Sub

Answer 3

无需复制和粘贴值。我选择了工作表（＆＃34;计算＆＃34;）以确保DailyGet将像以前一样运行。

Sub DailyComposite()

    Dim SrchRng As Range, cel As Range
    Set SrchRng = Worksheets("Summary").Range("B2:B100")

    With Worksheets("Calculations")
        .Select

        For Each cel In SrchRng

            If cel.Value <> "" Then

                Range("B1").Value = cel.Value

                Call DailyGet

                cel.Offset(0, 1).Resize(, 23).Value = Range("D3:Z3").Value

            End If
        Next cel
    End With

End Sub

Excel VBA在Foreach循环上运行宏而不切换表

3 个答案: