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方法。在可能的情况下，将您的操作应用到范围内通常会更好。

我做了一些上面的修改作为例子。

Answer 2

尝试在每个ws循环中添加ws.Activate：

For Each ws In wb.Worksheets
    ws.Activate
    LocationReport             
Next ws

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

2 个答案: