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

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

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

对于初学者，你可以摆脱所有的select

  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，请将其更改为表（“计算”）。 如果你这样做，你永远不需要切换工作表。

第三，在启动macros时closuresScreenUpdating，完成后重新打开：

 Application.ScreenUpdating = False 

Answer 2

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

  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

没有必要复制和粘贴值。 我select工作表（“计算”），以确保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