Excel VBA在沒有切換表的foreach循環上運行宏

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，請將其更改爲表格（「計算」）。如果你這樣做，你永遠不需要切換工作表。

三，關閉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

沒有必要複製和粘貼值。我選擇工作表（「計算」）以確保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