Question

我有一个要从中运行此代码的模板工作簿。代码是遍历目录中的所有文件，并遍历每个文件中的所有工作表。在每个工作表中，运行一个基本上对数据进行格式化的过程，然后将粘贴复制到模板工作簿中的工作表中，在该工作表中进行更多格式化。

当文件中只有一个工作表时，我拥有的此代码有效，但是当文件中只有一个工作表时，工作表循环将在模板工作簿上而不是文件上发生。

我已经将格式设置代码创建为另一个要调用的宏。我尝试在格式宏中添加工作表循环，但遇到相同的问题。

显式选项子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

'运行过程

'format data
Rows("1:14").Select
Selection.Delete Shift:=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.TextToColumns Destination:=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.Insert Shift:=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

结尾为

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.TextToColumns Destination:=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.TextToColumns Destination:=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").Insert Shift:=xlToRight


    Else

    End If

Next I


'format numbers to general
Columns("H:H").Select
Selection.TextToColumns Destination:=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.TextToColumns Destination:=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.TextToColumns Destination:=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.TextToColumns Destination:=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.TextToColumns Destination:=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.Insert Shift:=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

结尾为

    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

'结束过程

wbCopy.Activate

        ' 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

结束子子MemorySave（isOn为Boolean）

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

结束子

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遍历所有工作表。 {1}}。就像告诉excel，工作簿ws As Worksheet中工作表中的每个工作表。

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

1 个答案: