Добрый день! Есть файл с определенным количеством листов, на листах однотипные таблицы с тремя полями(артикул, наименование, кол-во) Артикулы одинаковые но в каждой таблице разный набор артикулов. Как сделать некую итоговую таблицу чтобы в нее были включены все артикулы из всех таблиц и количество повторяющихся артикулов суммировалось. Подскажите может быть есть уже какое-то готовое решение? Прикрепил банальный пример..т.к. реальный выложить не могу. 4 таблицы в каждой свой набор артикулов, необходимо сделать итоговую. В реале по 15-20 таблиц в каждой таблице по 300-400 строк
Добрый день! Есть файл с определенным количеством листов, на листах однотипные таблицы с тремя полями(артикул, наименование, кол-во) Артикулы одинаковые но в каждой таблице разный набор артикулов. Как сделать некую итоговую таблицу чтобы в нее были включены все артикулы из всех таблиц и количество повторяющихся артикулов суммировалось. Подскажите может быть есть уже какое-то готовое решение? Прикрепил банальный пример..т.к. реальный выложить не могу. 4 таблицы в каждой свой набор артикулов, необходимо сделать итоговую. В реале по 15-20 таблиц в каждой таблице по 300-400 строкratibor43
Таблицы однотипные, но на листах расположены не в одних и тех же местах (разные столбцы, строки)? На листах с таблицами есть ещё какая-то информация (кроме этих таблиц)? Часто ли приходится проделывать такую работу (её, в принципе, разово можно сделать и сводной по диапазонам)?
Таблицы однотипные, но на листах расположены не в одних и тех же местах (разные столбцы, строки)? На листах с таблицами есть ещё какая-то информация (кроме этих таблиц)? Часто ли приходится проделывать такую работу (её, в принципе, разово можно сделать и сводной по диапазонам)?AndreTM
ratibor43, на червертом листе заголовки для таблицы нарисуйте, и попробуйте так: [vba]
Код
Sub ertert() Dim x, t, i&, wsh As Worksheet With Sheets("итог") .Range("B2").CurrentRegion.Offset(1).ClearContents .Activate End With With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each wsh In ThisWorkbook.Worksheets If Not wsh Is ActiveSheet Then x = wsh.Range("B3").CurrentRegion.Value For i = 2 To UBound(x) If .Exists(x(i, 1)) Then t = .Item(x(i, 1)) t(2) = t(2) + x(i, 3) .Item(x(i, 1)) = t Else .Item(x(i, 1)) = Array(x(i, 1), x(i, 2), x(i, 3)) End If Next i End If Next wsh Range("B3").Resize(.Count, 3).Value = Application.Index(.items, 0, 0) End With End Sub
[/vba]
ratibor43, на червертом листе заголовки для таблицы нарисуйте, и попробуйте так: [vba]
Код
Sub ertert() Dim x, t, i&, wsh As Worksheet With Sheets("итог") .Range("B2").CurrentRegion.Offset(1).ClearContents .Activate End With With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each wsh In ThisWorkbook.Worksheets If Not wsh Is ActiveSheet Then x = wsh.Range("B3").CurrentRegion.Value For i = 2 To UBound(x) If .Exists(x(i, 1)) Then t = .Item(x(i, 1)) t(2) = t(2) + x(i, 3) .Item(x(i, 1)) = t Else .Item(x(i, 1)) = Array(x(i, 1), x(i, 2), x(i, 3)) End If Next i End If Next wsh Range("B3").Resize(.Count, 3).Value = Application.Index(.items, 0, 0) End With End Sub