沒有切換工作表的Foreach循環上的Excel VBA運行宏

Question

我在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

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之前切換到“計算”表。 如果函數dailyGet使用ActiveSheet，則將其更改為Sheets（“ Calculations”）。 如果這樣做，則無需切換工作表。

第三，在啟動宏時關閉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

無需復制和粘貼值。 我選擇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