Выборка из диапазона всех уникальных значений

[strannick]

Добрый день, уважаемые форумчане!
В продолжение темы о таблице сетевой структуры выкладываю то, что у меня получилось с таким вопросом:
Каким образом на лист 2 в первый столбец начиная со строки 3 из диапазона E3:T19 сделать выборку всех уникальных значений ID? И еще было бы неплохо сразу просуммировать все ячейки этого диапазона, которые соответствуют этим ID с результатом в соседнем столбце. Получить так сказать итоговую сумму по каждому встречающемуся в диапазоне ID. Полдня пролазил по инету, материалов масса, но что-то ничего подходящего не нашел. Или бессонная ночь дает о себе знать.
Заранее спасибо.

[Volodshan]

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

... материалов масса, но что-то ничего подходящего не нашел...

И сводная таблица не устраивает?.. И выборка уникальных расширенным фильтром?.. И подборка к ним по СУММЕСЛИ()?..

[kuklp]

Sub www()
    Dim i%, n&, c&, a, k&
    Worksheets("Лист2").UsedRange.ClearContents
    a = Worksheets(1).Range("E3:T19")
    ReDim b(1 To CInt(UBound(a, 2) / 2 * UBound(a, 1)), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        For c = 1 To UBound(a, 2) Step 2
            For i = 1 To UBound(a)
                If a(i, c) <> "" Then
                    If .exists(a(i, c)) Then
                        n = .Item((a(i, c)))
                        b(n, 2) = b(n, 2) + a(i, c + 1)
                    Else
                        k = k + 1: .Item((a(i, c))) = k
                        b(k, 1) = a(i, c): b(k, 2) = a(i, c + 1)
                    End If
                End If
            Next: Next
    End With
    Worksheets("Лист2").[a3].Resize(k, 2) = b
End Sub

[Serge 007]

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

И сводная таблица не устраивает?

Volodshan, просто для самообразования, покажите, как этот вопрос решается сводной?

[strannick]

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

Sub www()
    Dim i%, n&, c&, a, k&
    Worksheets("Лист2").UsedRange.ClearContents
    a = Worksheets(1).Range("E3:T19")
    ReDim b(1 To CInt(UBound(a, 2) / 2 * UBound(a, 1)), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        For c = 1 To UBound(a, 2) Step 2
            For i = 1 To UBound(a)
                If a(i, c) <> "" Then
                    If .exists(a(i, c)) Then
                        n = .Item((a(i, c)))
                        b(n, 2) = b(n, 2) + a(i, c + 1)
                    Else
                        k = k + 1: .Item((a(i, c))) = k
                        b(k, 1) = a(i, c): b(k, 2) = a(i, c + 1)
                    End If
                End If
            Next: Next
    End With
    Worksheets("Лист2").[a3].Resize(k, 2) = b
End Sub

Работает как часы. Сейчас еще потестю, но вроде порядок. Спасибо огромное.

[strannick]

Сообщение от Serge 007

Volodshan, просто для самообразования, покажите, как этот вопрос решается сводной?

Присоединяюсь. В данной задаче старался перевязывать все формулами. Поэтому для самообразования было бы неплохо.

[Volodshan]

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

...начиная со строки 3 из диапазона E3:T19 сделать выборку всех уникальных значений ID? И еще было бы неплохо сразу просуммировать все ячейки этого диапазона, которые соответствуют этим ID с результатом в соседнем столбце...

Варианты - сводная по диапазонам, консолидация (итоги макроса kuklp для сравнения).

[MCH]

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

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

Формульный вариант