Сравнить два массива и вывести в отдельный столбец кол-во вхождений

[Hugo121]

Думаю тут главное понять что такое словарь, какие у него возможности, как в него можно поместить данные и извлечь.
Ну а далее используем этот инструмент, если он удобен в конкретной задаче.
Думаю Вы ещё не изучили словарь с такими item'ами - массив, коллекция, словарь. Это уже несколько другие возможности.
Ну и вариант чуть проще (тоже часто можно применять) - в словаре в item храним номера строк массива, в котором собираем данные по этому конкретному ключу.
Это удобно применять, когда сразу известно максимально возможное количество ключей, и по каждому ключу нужно собрать более одного параметра.
Тогда если позволяет память можно сразу объявить такой пустой массив (например 10000х3), циклом по данным находим ключи, каждому в словаре запоминаем индекс этого массива (увеличиваем каждому новому), в массиве по этому индексу собираем данные.
Вот например по Вашему примеру - в массиве b в первом столбце собраны номера строк, где встретился ключ, во втором - слагаемые, в третьем - сумма, в четвётром сам ключ.

Sub dic_plus_arr_test()
    Dim a(), b(), i&, ind&, t&

    a = [a7:b37].Value
    ReDim b(1 To UBound(a), 1 To 4)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            If Not .exists(a(i, 1)) Then
                ind = ind + 1
                .Item(a(i, 1)) = ind
                b(ind, 4) = a(i, 1)
            End If
            t = .Item(a(i, 1))
            b(t, 1) = b(t, 1) & "|" & i
            b(t, 2) = b(t, 2) & "|" & a(i, 2)
            b(t, 3) = b(t, 3) + a(i, 2)
        Next
    End With

    [i7].Resize(ind, 4) = b
End Sub

Это только искусственный пример - в рабочем варианте вероятно нужно убирать лишний разделитель в начале, да и могут быть сюрпризы с длиной строки и данными при выгрузке на лист.

[VictorM]

Hugo121, а вот за это отдельное СПАСИБО!
Это то, о чем я говорил в своем первом посте - нормальное описание "человеческим" языком.
Буду читать/изучать/анализировать.
Спасибо за науку.

[VictorM]

Обещал отписаться о скорости.
Как я уже говорил, в моем прежнем варианте время обновление данных было = 4мин 30сек
Теперь же, с внедрением кодов от Hugo121 из этой темы время обновления = 24сек!!!
Да уж "Scripting.Dictionary" это сила! И скорость

[VictorM]

Здравствуйте, Уважаемые!
Вот, приходится поднять тему.
В пост #28 есть макрос от Hugo121 который я применял уже много раз, отлично работает.
Но вот понадобилось мне "вытащить" из таблицы не один, а два параметра.
Решил применить этот же, проверенный, но ничего не получилось у меня (:
попробовал сделать так

Sub compare3v2()    ' HUGO_ВПР()_одно значение - все работает
'а как ДВА и более?
    Dim a(), b(), i As Long
    Application.ScreenUpdating = False
    iRs = Sheets("справочник").[a7]
    iRow = Sheets("manager").[d7]
    If iRow > 0 Then
        With Sheets("manager")
            a = Sheets("справочник").Range("a11:c" & iRs + 10).Value    'где ищем
            b = .Range("d11:d" & iRow + 10).Value    'что ищем
            ReDim b(1 To UBound(a), 1 To 2) 'для 2-х значений
            With CreateObject("Scripting.Dictionary")
                'запоминаем в словаре перввые пары
                For i = 1 To UBound(a)
                    If Not .exists(a(i, 1)) Then .Item(a(i, 1)) = a(i, 2) '?
                Next
                'извлекаем запомненное
                For i = 1 To UBound(b)
                    b(i, 1) = .Item(b(i, 1))
                Next
            End With
            .[e11].Resize(UBound(b), 2) = b
        End With
    End If
End Sub

но, уже при добавлении строки

ReDim b(1 To UBound(a), 1 To 2) 'для 2-х значений

перестаёт работать, даже для одного значения.
Уже какой час бьюсь - никак.
Подскажите, пожалуйста, что нужно изменить/дописать, чтобы этот макрос мог искать в таблице 2 и более значений.
Спасибо.
ps Кстати, макрос из поста #31 оказался настолько универсальным, что уже и не помню, сколько раз я его применял в разных модификациях

[VictorM]

Забыл прикрепить файл.
Кстати, макрос от SAS888 из пост #29 получилось доделать.
Но все же хочется разобраться и с этим макросом.

[Hugo121]

Sub compare3v2()    ' HUGO_ВПР()
'а ДВА так. Да хоть десять.
    Dim a(), b(), i As Long, t As Long
    Application.ScreenUpdating = False
    iRs = Sheets("справочник").[a7]
    iRow = Sheets("manager").[d7]
    If iRow > 0 Then
        With Sheets("manager")
            a = Sheets("справочник").Range("a11:c" & iRs + 10).Value    'где ищем
            b = .Range("d11:d" & iRow + 10).Value    'что ищем
            ReDim c(1 To UBound(b), 1 To 2)    'массив для результатов
            With CreateObject("Scripting.Dictionary")
                'запоминаем в словаре позицию!!! пар
                For i = 1 To UBound(a)
                    .Item(a(i, 1)) = i
                Next
                'извлекаем по запомненной позиции
                For i = 1 To UBound(b)
                    If .exists(b(i, 1)) Then
                        t = .Item(b(i, 1))    'чтоб два раза не лазить в словарь
                        c(i, 1) = a(t, 2)
                        c(i, 2) = a(t, 3)
                    End If
                Next
            End With
            .[e11].Resize(UBound(b), 2) = c
        End With
    End If
End Sub

[VictorM]

а ДВА так. Да хоть десять.

Здравствуйте, Уважаемый Hugo121.
Большое спасибо!
Все отлично сработало.
Теперь вижу, где я "недопонял" , буду изучать дальше.
Спасибо!