遍历一个Excel工作表的所有宏工作簿

Question

我试图在Excel工作簿贯穿所有工作表的宏。我有下面的代码，但它只循环通过第一个工作表。宏一次又一次地在第一个工作表中运行，而不是像它应该进入下一个工作表。有人可以帮忙吗？以下是我的VBA代码。

Sub WorksheetLoop() 

    Dim WS_Count As Integer 
    Dim I As Integer 

    ' Set WS_Count equal to the number of worksheets in the active 
    ' workbook. 
    WS_Count = ActiveWorkbook.Worksheets.Count 

    ' Begin the loop. 
    For I = 1 To WS_Count 

     ' Insert your code here. 

'lRow = .Range("A" & .Rows.Count).End(xlUp).Row 
Range("P4").Select 
ActiveCell.FormulaR1C1 = "=RC[-10]&"" ""&RC[-5]" 
Range("P4").Select 
Selection.AutoFill Destination:=Range("P4:P65536"), Type:=xlFillDefault 
Range("P4:P500").Select 
ActiveWindow.SmallScroll Down:=-24 
Selection.Copy 
Range("R4").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Application.CutCopyMode = False 
ActiveSheet.Range("$R4:$R500").RemoveDuplicates Columns:=1, Header:=xlNo 
Selection.TextToColumns Destination:=Range("R4"), DataType:=xlDelimited, _ 
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ 
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ 
    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 
Range("U4").Select 
ActiveCell.FormulaR1C1 = "=INDEX(C[-16],MATCH(RC[-3],C[-15],0))" 
Range("V4").Select 
ActiveCell.FormulaR1C1 = "=INDEX(C[-12],MATCH(RC[-3],C[-11],0))" 
Range("U4:V4").Select 
Selection.AutoFill Destination:=Range("U4:V41"), Type:=xlFillDefault 
Range("U4:V500").Select 

     ' The following line shows how to reference a sheet within 
     ' the loop by displaying the worksheet name in a dialog box. 

     'MsgBox ActiveWorkbook.Worksheets(I).Name 

    Next I 
    Exit Sub 
    End Sub 

Answer 1

您需要通过每个循环切换到每个工作表。你基本上只是参考同一个。您的代码应该如下所示：

Sub WorksheetLoop() 
    Dim WS_Count As Integer 
    Dim I As Integer 

    ' Set WS_Count equal to the number of worksheets in the active 
    ' workbook. 
    WS_Count = ActiveWorkbook.Worksheets.Count 

    ' Begin the loop. 
    For I = 1 To WS_Count 

     ' Insert your code here. 
     Sheets(I).Select ' Added this command to loop through the sheets 

     'lRow = .Range("A" & .Rows.Count).End(xlUp).Row 
     Range("P4").Select 
     ActiveCell.FormulaR1C1 = "=RC[-10]&"" ""&RC[-5]" 
     Range("P4").Select 
     Selection.AutoFill Destination:=Range("P4:P65536"), Type:=xlFillDefault 
     Range("P4:P500").Select 
     ActiveWindow.SmallScroll Down:=-24 
     Selection.Copy 
     Range("R4").Select 
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
     Application.CutCopyMode = False 
     ActiveSheet.Range("$R4:$R500").RemoveDuplicates Columns:=1, Header:=xlNo 
     Selection.TextToColumns Destination:=Range("R4"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ 
     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ 
     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 
     Range("U4").Select 
     ActiveCell.FormulaR1C1 = "=INDEX(C[-16],MATCH(RC[-3],C[-15],0))" 
     Range("V4").Select 
     ActiveCell.FormulaR1C1 = "=INDEX(C[-12],MATCH(RC[-3],C[-11],0))" 
     Range("U4:V4").Select 
     Selection.AutoFill Destination:=Range("U4:V41"), Type:=xlFillDefault 
     Range("U4:V500").Select 

     ' The following line shows how to reference a sheet within 
     ' the loop by displaying the worksheet name in a dialog box. 

     'MsgBox ActiveWorkbook.Worksheets(I).Name 

    Next I 
    Exit Sub 
End Sub 

未检查其余代码的有效性，但我添加的命令将在表单中循环。问候，

Answer 2

不要遍历表的计数，遍历表。

也摆脱所有你不需要他们并删除那些选择行activewindow.smallscroll的。事情是这样的：

Range("A1").Formula = "Hello"代替Range("A1").SelectSelection.formula = "Hello"通知您可以直接删除选择和选择

下面是如何遍历表的例子：

Sub WS_Stuff() 
Dim WS As Worksheet 
For Each WS In Worksheets 
    MsgBox WS.Name 
Next 
End Sub 

Answer 3

你不需要.Select或.Activate¹工作表来处理在其上的命令。用With ... End With statement引用它并引用所有Range对象和Range.Cells属性（例如.）以继承父工作表引用。

Sub WorksheetLoop() 

    Dim lRow As Long, w As Long 

    With ActiveWorkbook 
     For w = 1 To .Worksheets.Count 
      With .Worksheets(w) 
       'the last row should be either from column F or K 
       lRow = .Range("K" & .Rows.Count).End(xlUp).Row 
       .Range("P4:P" & lRow).FormulaR1C1 = "=RC[-10]&CHAR(32)&RC[-5]" 
       '.Range("P4:P" & lRow).Formula = "=F4&CHAR(32)&K4" 
       With .Range("R4:R" & lRow) 
        .Value = .Range("P4:P" & lRow).Value 'direct value transfer is the preferred method for this 
        .RemoveDuplicates Columns:=1, Header:=xlNo 
        .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ 
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, _ 
            FieldInfo:=Array(Array(1, 1), Array(2, 1)) 
       End With 
       'R had duplicates removed; get the new last row 
       lRow = .Range("R" & .Rows.Count).End(xlUp).Row 
       .Range("U4:U" & lRow).FormulaR1C1 = "=INDEX(C[-16],MATCH(RC[-3],C[-15],0))" 
       '.Range("U4:U" & lRow).Formula = "=INDEX(E:E, MATCH(R4, F:F, 0))" 
       .Range("V4:V" & lRow).FormulaR1C1 = "=INDEX(C[-12],MATCH(RC[-3],C[-11],0))" 
       '.Range("V4:V" & lRow).Formula = "=INDEX(J:J, MATCH(S4, K:K, 0))" 

       With .Range("U4:V" & lRow) 
        'you left your code with columns U and V selected 
        'maybe more processing here like: 
        '.value = .value '<~~ remove formulas to their values 
       End With 
      End With 
     Next w 
    End With 

End Sub 

记录的宏代码非常冗长。它始终是通过代码的工作，除去像ActiveWindow.SmallScroll Down:=-24无用的代码行，使普通的改进，你可以是一个好主意。

---

¹_{见How to avoid using Select in Excel VBA macros更多的方法从依靠选择越来越远，并激活，以实现自己的目标。}