Свод нескольких файлов в один

[TVkills]

Доброго времени суток, уважаемые, помогите пожалуйста девушке сделать сводную таблицу.

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

П.С. Есть ли какое-то готовое решение для "сводов" любых форм, позволяющих суммировать цифровые значения показателей ячеек из разных таблиц одинаковой формы?

[TVkills]

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

Option Explicit
 
Sub Consolidated_Range_of_Books_and_Sheets()
    Dim iBeginRange As Range, rCopy As Range, lCalc As Long, lCol As Long
    Dim oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Worksheet, wsDataSheet As Worksheet, bPolyBooks As Boolean, avFiles
    Dim wbAct As Workbook
    Dim bPasteValues As Boolean
 
    On Error Resume Next
    'Выбираем диапазон выборки с книг
    Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    'для указания диапазона без диалогового окна:
    'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный
    'Если диапазон не выбран - завершаем процедуру
    If iBeginRange Is Nothing Then Exit Sub
    'Указываем имя листа
    'Допустимо указывать в имени листа символы подставки ? и *.
    'Если указать только * то данные будут собираться со всех листов
    sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
    'Если имя листа не указано - данные будут собраны со вех листов
    If sSheetName = "" Then sSheetName = "*"
    On Error GoTo 0
    'Запрос - вставлять на результирующий лист все данные
    'или только значения ячеек (без формул и форматов)
    bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "Excel-VBA") = vbYes)
    'Запрос сбора данных с книг(если Нет - то сбор идет с активной книги)
    If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 1
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
    'отключаем обновление экрана, автопересчет формул и отслеживание событий
    'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
    End With
    'создаем новый лист в книге для сбора
    Set wsDataSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    'если нужно сделать сбор данных на новый лист книги с кодом
    'Set wsDataSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    'цикл по книгам
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(Filename:=avFiles(li))
        Else
            Set wbAct = ThisWorkbook
        End If
        oAwb = wbAct.Name
        'цикл по листам
        For Each wsSh In wbAct.Worksheets
            If wsSh.Name Like sSheetName Then
                'Если имя листа совпадает с именем листа, в который собираем данные
                'и сбор идет только с активной книги - то переходим к следующему листу
                If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
                With wsSh
                    Select Case iBeginRange.Count
                    Case 1 'собираем данные начиная с указанной ячейки и до конца данных
                        lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                        iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                        sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
                    Case Else 'собираем данные с фиксированного диапазона
                        sCopyAddress = iBeginRange.Address
                    End Select
                    lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
                    'определяем для копирования диапазон только заполненных данных на листе
                    Set rCopy = Intersect(.Range(sCopyAddress).Parent.UsedRange, .Range(sCopyAddress))
                    'вставляем имя книги, с которой собраны данные
                    If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(rCopy.Rows.Count).Value = oAwb
                    'если вставляем только значения и форматы ячеек
                    If bPasteValues Then
                        rCopy.Copy
                        wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteValues
                        wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteFormats
                    Else 'если вставляем все данные ячеек(значения, формулы, форматы и т.д.)
                        rCopy.Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
                    End If
                End With
            End If
NEXT_:
        Next wsSh
        If bPolyBooks Then wbAct.Close False
    Next li
    With Application
        .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
    End With
End Sub

Наиболее приближенный к нашим нуждам макрос:

Sub п5()
Dim r As Range, cel As Range, wb As Workbook, awb As Workbook, s$, i&
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\files")
s = "Обработано:"
Set r = Range("E9:E29") 'задание диапазона суммирования
Set awb = ThisWorkbook
r.ClearContents
'проход по всем файлам в папке "\files"
For Each objFile In objFolder.Files
    Set wb = Workbooks.Open(objFile)
    i = i + 1
    s = s & vbCr & i & "." & objFile
    'проход по ячейкам
        For Each cel In r
        cel.Value = cel.Value + wb.Sheets("п5").Range(cel.Address)
        Next
    wb.Close False
Next
MsgBox s
End Sub

К сожалению он не удобен для работы, так как складывает ячейки в заданном диапазоне ВСЕХ файлов и только с одного листа.

Кто-то может помочь сделать комбинированный макрос?
Нужно что бы он производил суммирование чисел (числовых значений) в заданном диапазоне (в данном случае столбцы, можно сделать для нескольких строк-столбцов?) из указанных форм (выбранных вручную или находящихся в какой-то папке)

[TVkills]

Помогите, пожалуйста.

[Serge_Bliznykov]

Сообщение от TVkills

Кто-то может помочь сделать комбинированный макрос?

посмотрите, а макрос отсюда - https://excelvba.ru/code/CombineFiles
не решает ваши задачи?
В принципе, там же можно заказать платную доработку под себя.

p.s. чтобы получить помощь, неплохо бы сделать несколько тестовых файлов со структурой МАКСИМАЛЬНО приближенной к реальной. Тогда шанс получить конкретную помощь резко возрастает.

[TVkills]

Сообщение от Serge_Bliznykov

посмотрите, а макрос отсюда - https://excelvba.ru/code/CombineFiles
не решает ваши задачи?
В принципе, там же можно заказать платную доработку под себя.

p.s. чтобы получить помощь, неплохо бы сделать несколько тестовых файлов со структурой МАКСИМАЛЬНО приближенной к реальной. Тогда шанс получить конкретную помощь резко возрастает.

Все файлы с ОДИНАКОВОЙ структурой, точно такой же как в первом сообщении в табличке, только заполнены, цифры у всех разные, нужно их сложить (консолидировать)

Вышеприведенный макрос выполняет абсолютно другую функцию, он мерджит, собирает данные из разных книг в одну, а мне нужно что бы он тупо складывал суммы ячеек по всем ЛИСТАМ всех книг и выводил в сводную (частично заполненную заголовками, названиями ячеек... в соответствующие ячейки на соответствующих листах), не знаю как ещё проще объяснить
смотрите:

Е9_книга_одна_лист_один+Е9_книга другая_лист_один+...=Е9_свод_лист_о дин
Е9_книга_одна_лист_два+Е9_книга другая_лист_два+... =Е9_свод_лист_два
... так же по следующим ячейкам из заданного диапазона...
Е10+Е10+..=Е10_свод
и так далее,
очень бы хотелось что бы считало по заданному в диалоговом окне диапазону ячеек (удобно сделанному в первом макросе, там либо выделить надо либо указать начальную и он тогда будет собирать данные из всех нижерасположенных ячеек), что бы каждый раз в макросе не прописывать нужный лист, нужный диапазон.

[TVkills]

Великие умы, помогите пожалуйста!

[Serge_Bliznykov]

я вот лично пытался понять, что Вам нужно, но так до конца и не понял..

во-первых, в представленном в пост #1 файле таблицы.xlsx нет заполненных числами ячеек.
ладно. допустим, какие-то таблицы на листах п1, п4, п5, п6, п7 имеют числовые значения в столбце E.
допустим, что остальные столбцы (примечание, например) нас не интересуют.
допустим, что таких файлов с заполненными таблицами несколько.
и что каждый из файлов имеет строго такую же структуру.

что нужно сделать? Запустить макрос, он должен взять все файлы из указанной ему папки и сделать ЕЩЁ один файл, сводный, его структура полностью совпадает со структурой всех файлов (те же листы и те же таблицы), только в столбце E сумма ячеек из собранных файлов. Так?

Сумма в сводном файле должна быть представлена как
- просто одно число
- формула, содержащая сумму чисел из файлов в виде =15+22.5+17.3
- формула, содержащая суммы ссылок на исходные файлы?

а зачем Вам задавать какие-то диапазоны?
ведь структура файла есть и она не меняется?

ещё в вашем файле есть ячейка A5 c указанием периода (с даты по дату). Это игнорируется или на что-то влияет?


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

[TVkills]

Сообщение от Serge_Bliznykov

что нужно сделать? Запустить макрос, он должен взять все файлы из указанной ему папки и сделать ЕЩЁ один файл, сводный, его структура полностью совпадает со структурой всех файлов (те же листы и те же таблицы), только в столбце E сумма ячеек из собранных файлов. Так?

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

Сообщение от Serge_Bliznykov

Сумма в сводном файле должна быть представлена как

просто одно число

Сообщение от Serge_Bliznykov

а зачем Вам задавать какие-то диапазоны?
ведь структура файла есть и она не меняется?

сводов всегда много и формы разные, но в 90% случае на выходе нужно тупо получить итоговые значения показателей

Сообщение от Serge_Bliznykov

ещё в вашем файле есть ячейка A5 c указанием периода (с даты по дату). Это игнорируется или на что-то влияет?

Игнорируется, все отчеты идут за определенный период.

[Serge_Bliznykov]

вот теперь мне стало понятно, что нужно получить.

Сообщение от TVkills

сводов всегда много и формы разные, но в 90% случае на выходе нужно тупо получить итоговые значения показателей

а вот тут я не разделяю вашего оптимизма. Вряд ли можно тут говорить о "серебрянной пуле" - универсальному макросе, который будет работать на любых формах и сводах. Его придётся или подстраивать под разнообразные варианты, либо каждый раз вручную указывать, какие диапазоны интересуют.

ну вот, например, смотрите, в данном случае нужно складывать ячейки в столбце E
это можно прописать прямо в макросе.
Но, если вдруг, кто-то удалит/добавит/переставит столбец - то макрос перестанет работать.

[TVkills]

Сообщение от Serge_Bliznykov

а вот тут я не разделяю вашего оптимизма

поэтому понравившийся пример для выбора диапазона посредством vba во втором посте (в первой его половине), попробуйте у себя его запустить, справится такая часть vba кода с задачей, как думаете?