excel - 循环浏览所有工作簿和所有工作表，格式化并复制到模板

Question

我有一个要从中运行此代码的模板工作簿。代码是遍历一个目录中的所有文件，并遍历每个文件中的所有工作表。在每个工作表中，运行一个基本格式化数据的过程，然后将粘贴复制到模板工作簿中的工作表中，在该工作表中完成更多格式化。
当文件中只有一个工作表时，我拥有的这段代码有效，但是当有多个工作表时，工作表循环发生在模板工作簿而不是文件上。
我已将格式化代码创建为要调用的不同宏。我尝试在格式化宏中添加工作表循环，但遇到了同样的问题。

Option Explicit

Sub testLoopTabs()
    Dim MyFolder As String, MyFile As String
    Dim wb As Workbook, wbCopy As Workbook
    Dim ws As Worksheet 'to loop through all the sheets
    'Opens a file dialog box for user to select a folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        MyFolder =.SelectedItems(1)
        Err.Clear
    End With
    'stops screen updating, calculations, events, and status bar updates to help code run faster
    'you'll be opening and closing many files so this will prevent your screen from displaying that
    MemorySaveTrue
    'You can use this procedure instead 'This section will loop through and open each file in the folder you selected
    'and then close that file before opening the next file
    MyFile = Dir(MyFolder & "\", vbReadOnly)
    Set  wb = ThisWorkbook  'to refer to the workbook containing the code Do While MyFile <> ""
    Set  wbCopy = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False, ReadOnly:=True)  'loop worksheet
    ' Begin the loop.
    For Each ws In wbCopy.Worksheets
            'run process
            'format data
            Rows("1:14").Select
            Selection.DeleteShift:=xlUp
            Range("A1").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.WindowState = xlMaximized
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            Selection.UnMerge
            Columns("A:A").Select
            Selection.TextToColumnsDestination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
            Range("A1").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Columns("A:A").Select
            Selection.InsertShift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("A1").Select
            ActiveCell.FormulaR1C1 = "Market"
            Range("A2").Select
            ActiveCell.FormulaR1C1 = "=MID(CELL(""filename"",R[-1]C),FIND(""]"",CELL(""filename"",R[-1]C))+1,255)"
            Range("A2").Select
            Selection.Copy
            With Range("B1")
                Range(.Cells(2, 0),.End(xlDown).Offset(0, -1)).Select
            End With
            ActiveSheet.Paste
            'format dates and text to column
            Columns("E:F").Select
            Application.CutCopyMode = False
            Selection.NumberFormat = "dd/mm/yyyy"
            Columns("E:E").Select
            Selection.TextToColumnsDestination:=Range("E1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
            Columns("F:F").Select
            Selection.TextToColumnsDestination:=Range("F1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
             'find Net Value column
            Dim cell As Range
            Dim I As Integer
            For I = 12 To 20
                If Cells(1, I).Value = "Net Amount" Then
                    Columns(I).Select
                    Selection.Cut
                    Columns("K:K").InsertShift:=xlToRight
                Else
                End If
            Next I

            'format numbers to general
            Columns("H:H").Select
            Selection.TextToColumnsDestination:=Range("H1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
            Columns("I:I").Select
            Selection.TextToColumnsDestination:=Range("I1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
            Columns("K:K").Select
            Selection.TextToColumnsDestination:=Range("K1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
            Columns("L:L").Select
            Selection.TextToColumnsDestination:=Range("L1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
            Columns("M:M").Select
            Selection.TextToColumnsDestination:=Range("M1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
             'add Other Charges
            Columns("N:N").Select
            Selection.InsertShift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("N1").Select
            ActiveCell.FormulaR1C1 = "Other Charges"
            Range("N2").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = "=IF(RC[-7]=""B"",ROUND(RC[-3]-RC[-2]-RC[-1],2),ROUND(RC[-2]-RC[-3]-RC[-1],2))"
            Range("N2").Select
            If IsEmpty(Range("B3")) = False Then
                Range("N2").Select
                Selection.Copy
                With Range("M2")
                    Range(.Cells(2, 2),.End(xlDown).Offset(0, 1)).Select
                End With
                ActiveSheet.Paste
                Range("A2:N2").Select
                Range(Selection, Selection.End(xlDown)).Select
                Application.CutCopyMode = False
                Selection.Copy
            Else
                Range("A2:N2").Copy
            End If

            'paste to brokertradefile
            wb.Worksheets("BrokerTradeFile").Activate
            Range("A6").End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            'end process
            wbCopy.Activate
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBoxws.Name
            Next ws

        MsgBoxwbCopy.Name
        wbCopy.CloseSaveChanges:=False
        MyFile = Dir
    Loop

    'turns settings back on that you turned off before looping folders
    MemorySaveFalse
End Sub

Sub MemorySave(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not(isOn)
    Application.ScreenUpdating = Not(isOn)
    Application.DisplayStatusBar = Not(isOn)
    ActiveSheet.DisplayPageBreaks = False
End Sub

Answer 1

这是我将如何做到这一点:

Option Explicit
Sub testLoopTabs()

    Dim MyFolder As String, MyFile As String
    Dim wb As Workbook, wbCopy As Workbook
    Dim ws As Worksheet 'to loop through all the sheets

    'Opens a file dialog box for user to select a folder

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

    'stops screen updating, calculations, events, and statsu bar updates to help code run faster
    'you'll be opening and closing many files so this will prevent your screen from displaying that
    MemorySave True 'You can use this procedure instead

    'This section will loop through and open each file in the folder you selected
    'and then close that file before opening the next file

    MyFile = Dir(MyFolder & "\", vbReadOnly)
    Set wb = ThisWorkbook 'to refer to the workbook containing the code

    Do While MyFile <> ""
        Set wbCopy = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False, ReadOnly:=True)
        'loop worksheet
         ' Begin the loop.
        For Each ws In wbCopy.Worksheets
            'run process
            Call formattradefiledata
            'end process

            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBox ws.Name
        Next ws
        MsgBox wbCopy.Name
        wbCopy.Close SaveChanges:=False
        MyFile = Dir
    Loop

    'turns settings back on that you turned off before looping folders
    MemorySave False

End Sub
Sub MemorySave(isOn As Boolean)

    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    Application.DisplayStatusBar = Not (isOn)
    ActiveSheet.DisplayPageBreaks = False

End Sub

请注意，我为您的内存管理添加了另一个过程(您只需要使用 True 调用该过程以激活内存节省选项并使用 false 调用它以重新打开所有内容)。

当您引用工作簿和工作表时，什么都不会出错。在我的代码中，带有代码的工作簿被引用为 wb ，正在打开的文件被引用为 wbCopy并循环浏览您可以使用的所有工作表 For Each ws In wbCopy.Worksheets在您引用 ws As Worksheet 之后.就像告诉 excel，对于工作簿中工作表中的每个工作表 wbCopy .