Создание консолидированного отчета

Рассмотрим пример еще одной полезной пакетной обработки. Допустим вам как сотруднику множество подразделений присылает однотипные отчеты и вашей задачей является собрать их в одни файл и переслать руководителю. Либо же вы руководитель, и собираете подобные консолидированные отчеты от подчиненных. Т.е. это простая рутинная работа - скопировать данные из одного файла и вставить его в консолидирующий и так 30 раз. Для этого случая можно сделать пакетную обработку - сохранить все нужные к обработке файлы в одной папке - программа сама создаст сводный файл и проведет копирование однотипных данных из всех файлов в папке в этот файл.
Как всегда важная деталь - файл из которого вы будете запускать этот макрос не должен находится в этот папке, чтобы его преждевременное открытие не вызвало ошибку. Макрос нужно запускать из любого другого открытого файла.

Приведем код

Sub Консолидация()
    ' Макрос создает книгу и последовательно вставляет на одноименные листы
    ' данные из всех xls файлов заданной директории начиная со строки FRow.
    Const FRow& = 1               ' Номер строки начала сбора данных
    Const Sborka$ = "Сборка.xls"   ' Имя сборочного файла
    Dim FCol&, LCol&               ' Переменные номеров первого и последнего столбца для сбора данных
    Dim LRow&, LRow_Cel&
    Dim wb_Cel As Workbook, wb_Tek As Workbook
    Dim Sh_Cel As Worksheet, Sh_Tek As Worksheet
    Dim MyPath$, MyFileName$, MyFulName$
    Dim Uslovie1 As Boolean
    ' Вызываем функцию GetFolderPath для вызова окна выбора папки
     MyPath = GetFolderPath
     ' Указываем переменную массива файлов (без маски)
    MyFileName = Dir(MyPath & "*.xls*")
    Uslovie1 = False
    ' Вызываем функцию Do Until - это цикл перебора похожий на for next
    ' отличие лишь в том что у него нет второго условия To, он обрабатываем данные до конца
    ' пока условие указанное в нем выполняется
    Do Until MyFileName = ""
        If MyFileName <> Sborka Then
            MyFulName = MyPath & MyFileName
            Workbooks.Open Filename:=MyFulName, UpdateLinks:=0
            If Not Uslovie1 Then
                Set wb_Cel = ActiveWorkbook
                ActiveWorkbook.SaveAs Filename:=MyPath & Sborka, FileFormat:=xlExcel8
                Uslovie1 = True
            Else
                Set wb_Tek = ActiveWorkbook
                'вызываем циклы for each для перебора массива ячеек в копируемых диапазонах
                ' программа определяет так называемую текущую область - диапазон с заполненными данными
                For Each Sh_Cel In wb_Cel.Sheets
                    With Sh_Cel
                        FCol = .UsedRange.Cells(1, 1).Column
                        LCol = .UsedRange.Columns.Count + FCol - 1
                        ' Чтобы итоговые таблички вставлились в сводный файл удобочитаемо
                        ' укажем, что между копируемыми диапазонами нужно вставить пустую строку -   '(.Row+2)
                        LRow_Cel = .Cells(.Rows.Count, FCol).End(xlUp).Row + 2
                    End With
                    For Each Sh_Tek In wb_Tek.Sheets
                        If Sh_Tek.Name = Sh_Cel.Name Then
                            With Sh_Tek
                                LRow = .Cells(.Rows.Count, FCol).End(xlUp).Row
                                If LRow >= FRow Then
                                    .Cells.CurrentRegion.Copy Sh_Cel.Cells(LRow_Cel, 1)
                                End If
                            End With
                        End If
                    Next Sh_Tek
                Next Sh_Cel
                Workbooks(MyFileName).Close SaveChanges:=False
            End If
        End If
        MyFileName = Dir
    Loop
End Sub

Данный код скопирует все данные с первых листов всех отчетов в папке и вставит их через строчку в файл сводный. Сохраните его в книге учет производства, назначьте кнопку и опробуйте на полученных данных более ранней групповой обработки отчетов себестоимость, либо же попробуйте на других данных (например на отчетах не привязанных позиций).

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

Комментарии

Популярные сообщения из этого блога

Запуск макросов в автоматическом режиме по расписанию

Пакетная обработка отчетов

Отправка отчетов по электронной почте