Имя Значение Имя Значение Иван 5 Петр 9 Леша 5 Федя 7 Федя 1 Иван 9 Лена 3 Катя 7
Нужно получить 2 столбца. 1-ый это выборка уникальных имен 2-ой. Это сумма значений для каждого конкретного имени Желательно сортировку по значениям от большего к меньшему
То есть что нужно получить: Имя Значение Иван 14 Петр 9 Федя 8 Катя 7 Леша 5 Лена 3
Может и глупо, но заранее спасибо за ответ. p.s. пытаюсь понять формулу. По факту мне надо будет объединить 20 таблиц по 100 имен ( по 2 столбца в каждой таблице). Приложил файл
Есть 4 столбца
Имя Значение Имя Значение Иван 5 Петр 9 Леша 5 Федя 7 Федя 1 Иван 9 Лена 3 Катя 7
Нужно получить 2 столбца. 1-ый это выборка уникальных имен 2-ой. Это сумма значений для каждого конкретного имени Желательно сортировку по значениям от большего к меньшему
То есть что нужно получить: Имя Значение Иван 14 Петр 9 Федя 8 Катя 7 Леша 5 Лена 3
Может и глупо, но заранее спасибо за ответ. p.s. пытаюсь понять формулу. По факту мне надо будет объединить 20 таблиц по 100 имен ( по 2 столбца в каждой таблице). Приложил файл isbobrov
Sub svod() Application.ScreenUpdating = False Set tbl = [b2].CurrentRegion With CreateObject("Scripting.Dictionary") For i = 2 To tbl.Rows.Count For j = 1 To tbl.Columns.Count - 1 If tbl(1, j) = "Имя" Then If .Exists(Trim(tbl(i, j))) Then .Item(Trim(tbl(i, j))) = .Item(Trim(tbl(i, j))) + tbl(i, j + 1) Else .Add Trim(tbl(i, j)), tbl(i, j + 1) End If End If Next j, i [h3].CurrentRegion.Offset(2).Clear [h3].Resize(.Count) = Application.Transpose(.keys) [i3].Resize(.Count) = Application.Transpose(.items) Set res = [h3].Resize(.Count, 2) With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=res.Columns(2), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SetRange res .Apply End With End With Application.ScreenUpdating = True End Sub
[/vba]
isbobrov, можно макросом:
[vba]
Код
Sub svod() Application.ScreenUpdating = False Set tbl = [b2].CurrentRegion With CreateObject("Scripting.Dictionary") For i = 2 To tbl.Rows.Count For j = 1 To tbl.Columns.Count - 1 If tbl(1, j) = "Имя" Then If .Exists(Trim(tbl(i, j))) Then .Item(Trim(tbl(i, j))) = .Item(Trim(tbl(i, j))) + tbl(i, j + 1) Else .Add Trim(tbl(i, j)), tbl(i, j + 1) End If End If Next j, i [h3].CurrentRegion.Offset(2).Clear [h3].Resize(.Count) = Application.Transpose(.keys) [i3].Resize(.Count) = Application.Transpose(.items) Set res = [h3].Resize(.Count, 2) With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=res.Columns(2), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SetRange res .Apply End With End With Application.ScreenUpdating = True End Sub