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

您无需.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。}

Answer 3

不要遍历纸张计数，循环通过纸张。

还要删除所有不需要它们的activewindow.smallscroll行并删除选择。像这样：

Range("A1").Formula = "Hello"代替Range("A1").Select Selection.formula = "Hello"请注意，您只需删除选择和选择

以下是如何循环工作表的示例：

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

循环宏通过Excel工作簿中的所有工作表

3 个答案: