Просмотрите все рабочие книги и все рабочие таблицы, отформатируйте и скопируйте в шаблон - PullRequest
Новая
       1

Просмотрите все рабочие книги и все рабочие таблицы, отформатируйте и скопируйте в шаблон

2 голосов
/ 04 июня 2019

У меня есть шаблон книги, из которой я хочу запустить этот код. Код должен циклически проходить по всем файлам в каталоге и циклически проходить по всем рабочим листам в каждом файле. На каждом рабочем листе запустите процесс, который в основном форматирует данные, а затем скопируйте вставку на рабочий лист внутри рабочей книги шаблона, где выполняется дополнительное форматирование.

Этот код, который у меня работает, работает, когда в файле есть только один рабочий лист, но если их несколько, цикл циклического листа происходит в книге шаблона вместо файлов.

Я создал код форматирования в виде другого макроса для вызова. Я попытался добавить цикл листа в макрос форматирования, но получил ту же проблему.

Параметр Явный 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

'запустить процесс 

'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

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

1 Ответ

0 голосов
/ 04 июня 2019

Вот как я бы это сделал: 

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.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...