Страницы: 1
RSS
Сведение данных из множества вкладок в один лист, Пример во вложении
 
Добрый день, прошу помочь решить следующую задачу:

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

Как автоматизировать этот процесс? Дело в том, что я прислал упрощенный пример задачи, а в действительности 40 этапов и около 30 пунктов (услуг), которые выполняются в разное время. Причем количество вкладок этапов может быть и 5 и 30 в зависимости от проекта.

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

У меня получается это сделать только с помощью комбинации ЕСЛИОШИБКА, ДВССЫЛ, ИНДЕКС, ПОИСКПОЗ, но для моего диапазона это мучительно долгий расчет, каждое небольшое изменение сильно тормозит ноутбук.
 
Артур Давидов, вот если ваши реальные данные такие же идеальные как ваш приложенный пример, а именно - на всех листах услуги находятся на одних и тех же строках, а так же даты в одних и тех же столбцах, то это сделать легко. См. файл
Если же у вас услуги на всех листах написаны на разных строках (где-то услуга 1 на 2-й строке, а где-то она же на 5-й строке, а где-то на 10-й строке), а так же даты (где-то февраль в столбце D, а где-то февраль в столбце F, а где-то в K) - то уже сложнее и нужно дописывать макрос.

Код
Sub SumStages()
    Dim SvodSht As Worksheet, TempSht As Worksheet, LastRow As Long, LastCol As Long
    
    Application.ScreenUpdating = False
    Set SvodSht = Worksheets("СВОД")
    SvodSht.Cells.Clear
    Worksheets("Этап 1").Range("A1").CurrentRegion.Copy SvodSht.Range("A1")
    With SvodSht
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    For Each TempSht In Worksheets
        If TempSht.Name <> "Этап 1" And TempSht.Name <> SvodSht.Name Then
            With TempSht
                .Range("C2", .Cells(LastRow - 1, LastCol)).Copy
            End With
            SvodSht.Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
        End If
    Next TempSht
    SvodSht.Activate
    SvodSht.Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Данные просуммированы!", vbInformation, "Конец"
End Sub
Изменено: New - 25.06.2022 12:20:19
 
Спасибо, большое, вы правы в части сложности. Наименование и расположение услуг в одних и тех же местах, а вот даты разные
 
Артур Давидов, если никто не поможет, могу написать макрос за деньги
Страницы: 1
Наверх