循环宏通过Excel工作簿中的所有工作表[重复]

3 回答

• 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
  

  没有检查其余代码的有效性，但我添加的命令将在工作表中循环 . 问候，

  回复于 2024-05-07T06:11:45+08:00
• 0

  您不需要.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 这样无用的代码行并尽可能地进行一般性改进总是一个好主意 .

  ---

  ¹请参阅如何避免在Excel VBA宏中使用选择以获取更多方法，以避免依赖选择和激活来实现目标 .

  回复于 2024-05-07T06:11:45+08:00
• 0

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

  还要删除所有那些不需要它们的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
  

  回复于 2024-05-07T06:11:45+08:00