>我有一个模板工作簿，我想从中运行此代码。 代码是遍历目录中的所有文件，并循环遍历每个文件中的所有工作表。在每个工作表中，运行一个基本上设置数据格式的过程，然后将粘贴复制到模板工作簿中的工作表中，在该工作表中完成更多格式设置。
当文件中只有一个工作表时，我拥有的这段代码有效，但是当有多个工作表时，工作表循环发生在模板工作簿而不是文件上。
我已将格式代码创建为要调用的不同宏。 我尝试在格式宏中添加工作表循环，但遇到了同样的问题。
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
以下是我的做法：
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，并在引用ws As Worksheet后循环遍历您可以使用For Each ws In wbCopy.Worksheets的所有工作表。就像告诉excel，对于工作簿wbCopy工作表中的每个工作表。