vba - Excel VBA循环遍历所有工作簿和所有工作表

Question

我想创建一个 Excel VBA 来循环遍历所有 .xlsx 文件以及这些文件中的所有工作表。但是，我这里的代码只会处理第一张纸，而不是所有纸。如果我的代码有问题，有人可以告诉我吗？非常感谢!

Sub Rollup()

Dim wb As Workbook, MyPath, MyTemplate, MyName
Dim ws As Worksheet

MyPath = "I:\Reports\Rollup Reports\"
MyTemplate = "*.xlsx"  
MyName = Dir(MyPath & MyTemplate)    
Do While MyName <> ""
    Set wb = Workbooks.Open(MyPath & MyName)
        For Each ws In wb.Worksheets
            LocationReport             
        Next ws
    wb.Close True    
    MyName = Dir()                 
Loop
End Sub

Sub LocationReport()

Application.ScreenUpdating = False

Range("N4").Select
ActiveCell.FormulaR1C1 = "1"
Range("N4").Select
Selection.Copy
Range("B2:J7,B10:J20,B23:J28").Select
Range("B23").Activate
Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
    False, Transpose:=False
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Application.ScreenUpdating = True

End Sub

Answer 1

处理此问题的可扩展且类似 OOP 的方法是将工作表作为参数传递:

Sub Rollup()
    Dim wb As Workbook, MyPath, MyTemplate, MyName
    Dim ws As Worksheet

    MyPath = "I:\Reports\Rollup Reports\"
    MyTemplate = "*.xlsx"
    MyName = Dir(MyPath & MyTemplate)
    Do While MyName <> ""
        Set wb = Workbooks.Open(MyPath & MyName)
            For Each ws In wb.Worksheets
                LocationReport (ws)
            Next ws
        wb.Close True
        MyName = Dir()
    Loop
End Sub

Sub LocationReport(ByRef ws As Worksheet)
    Application.ScreenUpdating = False

    With ws
      .Range("N4").FormulaR1C1 = "1"
      .Range("N4").Copy
      .Range("B2:J7,B10:J20,B23:J28").Select
      .Range("B23").Activate
      .Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
            False, Transpose:=False

      With .Rows("1:1")
        Application.CutCopyMode = False
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      End With
    End With

    Application.ScreenUpdating = True
End Sub

另外，稍微偏离主题，但我尽量避免使用 Range.Select 然后使用 Selection.Method 方法。如果可能的话，通常最好将您的操作应用于该范围。

我做了一些上面的更改作为示例。