遍歷一個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更多的方法從依靠選擇越來越遠，並激活，以實現自己的目標。}