Построчный поиск уникальных значений с заданным критерием

[meosezz]

Добрый день всем!
Вопрос к знатокам экселя

Суть - есть таблица с позициями (столбец A), у каждой позиции свой артикул (столбец B), который может повторяться, эти позиции также разбиты на параметры "Длина" и "Кол-во" (в файле два варианта: где эти параметры разделены и где идут вперемешку). Далее в столбцах D:M идут данные с других вкладок (в примере вставлено значениями), которые сами подтягиваются формулой.

Так вот, под этой таблицей внизу нужен отбор уникальных значений по артикулам. Уникальные значения из столбца B отобраны (находятся в B88:B95), а вот отобрать уникальные значения со строк по критерию не получается. В диапазоне  D92:O93 приведен пример как должен выглядеть результат отбора

Были попытки отбирать с помощью формулы уникальные значения (O4:X85), но это только по строкам происходит. А мне  нужно по артикулам

Буду благодарна любой помощи!
Эксель 2019 г., макрос или формулы - не столь важно

[Дмитрий Щербаков(The_Prist)]

Не очень понятны критерии отбора именно уникальных. В диапазоне D92:O93 кол-во повторяется, длина нет. Сначала подумал, что надо отбирать уникальные по связке: Артикул-Длина-Кол-во. Но и это не подходит под пример результата. Для Длины "3278" разное кол-во, но оно не отражено. Может кол-во надо суммировать для связки Артикул-Длина? Но об этом же надо было написать, а не ждать, что об этом додумаются те, кто захочет помочь. Вдруг и это неверно, хоть и похоже на правду?
Т.е. Вы вроде упоминаете какой-то критерий, но ничего конкретного про него не пишете. Что это за другой критерий? Длина? Заголовок столбца? Еще что-то? Опишите на примере одного артикула, как должны отобраться уникальные значения для него и почему так. Без этого вряд ли найдется много желающих угадывать действительно верную задачу. И тем более писать под это дело не самую простую формулу или чуть более простой макрос.
И так же надо знать может ли меняться кол-во столбцов - иначе напишут под конкретное кол-во, а окажется, что их может быть любое кол-во и надо переделывать.

Да, забыл еще один момент: у Вас представлено два варианта расположения данных. И для макроса, и для формулы это критично. По сути для каждого из вариантов нужен будет свой вариант макроса. Универсально сделать куда сложнее.

[Дмитрий Щербаков(The_Prist)]

В общем было интересно размять мозг на задачке, поэтому ниже универсальный код - подходит к обеим ситуациям.
Выделяете строки таблицы без заголовков, которые надо обработать(в любом столбце - программа возьмет строки только от А до М) и запускаете код:

Код Выделить Развернуть

'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
' Purpose:
'---------------------------------------------------------------------------------------
Sub GetUnique_LenghtAndSumCount()
    Dim dic As Object, dicCount As Object, dictmp As Object, dicRes As Object
    Dim arr, ares, asp, acols, x, lx, lr&, lrr&, lmax_c&, lc, lcc&
    Dim s$, skey$, slenght$
    Dim lcnt&
   
    Set dic = CreateObject("scripting.dictionary")
    dic.comparemode = 1
    'только первые 13 столбцов среди выделенных на листе строк
    arr = Selection.EntireRow.Resize(, 13).Value
    lmax_c = 1
   
    For lr = 1 To UBound(arr, 1)
        If StrComp(arr(lr, 3), "длина", 1) = 0 Then
            For lc = 4 To UBound(arr, 2)
                slenght = arr(lr, lc)
                If slenght <> "" Then
                    skey = arr(lr, 2) ' & "|" & slenght
                    If Not dic.exists(skey) Then
                        Set dicCount = CreateObject("scripting.dictionary")
                        dicCount.comparemode = 1
                        dic.Add skey, dicCount
                    End If
                    Set dicCount = dic.Item(skey)
                    s = slenght & "|" & arr(lr, 1)
                    If Not dicCount.exists(s) Then
                        dicCount.Add s, Array(lc)
                    Else
                        acols = dicCount.Item(s)
                        ReDim Preserve acols(UBound(acols) + 1)
                        acols(UBound(acols)) = lc
                        dicCount.Item(s) = acols
                    End If
                    Set dic.Item(skey) = dicCount
                End If
            Next
        End If
    Next
   
    Set dicRes = CreateObject("scripting.dictionary")
    dicRes.comparemode = 1
    For lr = 1 To UBound(arr, 1)
        If StrComp(arr(lr, 3), "кол-во", 1) = 0 Then
            skey = arr(lr, 2)
            If dic.exists(skey) Then
                If Not dicRes.exists(skey) Then
                    Set dictmp = CreateObject("scripting.dictionary")
                    dictmp.comparemode = 1
                    dicRes.Add skey, dictmp
                End If
                Set dictmp = dicRes.Item(skey)
                Set dicCount = dic.Item(skey)
                acols = dicCount.keys
                For Each x In dicCount.keys
                    asp = Split(x, "|")
                    s = asp(0)
                    If arr(lr, 1) = asp(1) Then
                    acols = dicCount.Item(x)
                    lcnt = 0
                    For Each lc In acols
                        If arr(lr, lc) <> "" Then
                            lcnt = lcnt + arr(lr, lc)
                        End If
                    Next
                    dictmp.Item(s) = dictmp.Item(s) + lcnt
                    End If
                Next
                Set dicRes.Item(skey) = dictmp
                If dictmp.Count > lmax_c Then
                    lmax_c = dictmp.Count
                End If
            End If
        End If
    Next
   
    ReDim ares(1 To dic.Count * 2, 1 To lmax_c + 2)
    lrr = 1
    For Each x In dicRes.keys
        ares(lrr, 1) = x
        ares(lrr, 2) = "Длина"
        ares(lrr + 1, 2) = "Кол-во"
       
        Set dictmp = dicRes.Item(x)
        lcc = 3
        For Each lx In dictmp.keys
            ares(lrr, lcc) = lx
            ares(lrr + 1, lcc) = dictmp.Item(lx)
            lcc = lcc + 1
        Next
        lrr = lrr + 2
    Next
    'выводим результат, начиная с ячейки В100
    Cells(100, 2).Resize(UBound(ares, 1), UBound(ares, 2)).Value = ares
End Sub

[meosezz]

Доброе утро
Критерий в данном случае - это артикул, т.к. требуется собирать количество шт. профилей определенной длины для конкретного артикула (т.е. для разных артикулов может быть одинаковая длина профилей). Про связку Артикул-Длина не очень поняла, но если артикул и длина совпадают, то кол-во нужно суммировать, да. Задачу не очень корректно описала, понимаю

Макрос работает замечательно! Даже если менять номер строки вывода и кол-во столбцов. Спасибо Вам!