Excel VBA 在 Foreach 循环上运行宏而不切换工作表答案

【问题标题】：Excel VBA Running Macros on Foreach Loop without Switching SheetsExcel VBA 在 Foreach 循环上运行宏而不切换工作表
【发布时间】：2016-06-21 03:03:56
【问题描述】：

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

Sub DailyComposite()

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

For Each cel In SrchRng

    If cel.Value <> "" Then

        Worksheets("Calculations").Range("B1").Value = cel.Value
        Sheets("Calculations").Select
            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

    End If

Next cel

    Sheets("Calculations").Select
    Application.CutCopyMode = False
    Range("A1").Select
    Sheets("Summary").Select
    Range("A1").Select

End Sub

【问题讨论】：

标签： vba excel foreach macros

【解决方案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 之前切换到计算表。如果 dailyGet 函数使用 ActiveSheet，请将其更改为 Sheets("Calculations")。如果你这样做了，你永远不需要切换工作表。

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

Application.ScreenUpdating = False

【讨论】：

【解决方案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

【讨论】：

【解决方案3】：

无需复制和粘贴值。我选择 Worksheets("Calculations") 以确保 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

【讨论】：