Sub motiv()
    Dim T: T = Timer
    'Dim dic As New Dictionary
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim shRep As Worksheet, shResult As Worksheet
    Dim r As Long, d As Long
    
    Dim NK, Dt, TP, Manager
    Dim tmpKey As Variant, tmpArr()
    
    Set shRep = ActiveWorkbook.Sheets("Отчет")
    
    'нужные столбцы (ищем в первом столбце)
    Manager = Application.Match("Менеджер по сделке", shRep.Rows(1), 0)
    TP = Application.Match("тип продукта", shRep.Rows(1), 0)
    Dt = Application.Match("Дата и время операции", shRep.Rows(1), 0)
    NK = Application.Match("НК", shRep.Rows(1), 0)
    
    'перебираем все строки
    For r = 2 To shRep.Cells(shRep.Rows.Count, NK).End(xlUp).Row
        For d = 1 To 3 'из каждой записи делаем 3 новых записи (1,2,3 рабочих дня от даты операции - ожидаемое появление пифа)
            'ключ (НК + тип + дата появляения ПИФа)
            tmpKey = shRep.Cells(r, NK) & "_" & shRep.Cells(r, TP) & "_" & WorksheetFunction.WorkDay(shRep.Cells(r, Dt), d) 'можно добавить праздники, нужен список
            If Not dic.Exists(tmpKey) Then 'если ключ не найден
                'добавляем элемент с указанием менеджера (как массив, что бы потом можно было расширить)
                dic.Add tmpKey, Array(shRep.Cells(r, Manager).Value)
            Else
                'если такой ключ уже есть
                If IsError(Application.Match(shRep.Cells(r, Manager), dic(tmpKey), 0)) Then 'проверяем текущего менеджера в списке менеджеров в массиве
                    'и если такого менеджера там нет
                    tmpArr = dic(tmpKey) 'считываем элемент во временный массив
                    ReDim Preserve tmpArr(UBound(tmpArr) + 1) 'увеличиваем временный массив
                    tmpArr(UBound(tmpArr)) = shRep.Cells(r, Manager).Value 'добавляем текущего менеджера
                    dic(tmpKey) = tmpArr 'и переписываем временный массив обратно в словарь
                End If
            End If
        Next d
    Next r
    
    Set shResult = ActiveWorkbook.Sheets.Add 'создаем новый лист
    For Each tmpKey In dic 'перебираем словарь по ключам
        If UBound(dic(tmpKey)) > 0 Then 'если элемен словаря - это массив с более чем одним элементом
            r = shResult.Cells(shResult.Rows.Count, "A").End(xlUp).Row + 1 'первая незаполненная строка
            With shResult.Range("A" & r & ":C" & r)
                .Value = Split(tmpKey, "_") 'парсим ключ
                .FormulaLocal = .FormulaLocal 'преобразуем НК и дату к числовому виду
            End With
            shResult.Cells(r, "C").NumberFormat = "m/d/yyyy" 'формат даты
            'вставляем менеджеров из массива (диапазон вычисляется исходя из размерности массива)
            shResult.Range(shResult.Range("D" & r), shResult.Range("D" & r).Offset(0, UBound(dic(tmpKey)))) = dic(tmpKey)
        End If
    Next tmpKey
    
    MsgBox "Done: " & Round(Timer - T, 2) & " sec."
End Sub

Sub Motiv(sFileSelected)
    xlUp = -4162
   
    Dim T: T = Timer
    Dim dic 
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim ExApp, wb
    Set ExApp = CreateObject("Excel.Application")
    set wb = ExApp.Workbooks.Open(sFileSelected)
    ExApp.Visible = True
   
    Dim shRep, shResult, r, d
    Dim NK, Dt, TP, Manager
    Dim tmpKey, tmpArr
    
    Set shRep = wb.Sheets("Отчет")
    
    'нужные столбцы (ищем в первом столбце)
    Manager = ExApp.Match("Менеджер по сделке", shRep.Rows(1), 0)
    TP = ExApp.Match("тип продукта", shRep.Rows(1), 0)
    Dt = ExApp.Match("Дата и время операции", shRep.Rows(1), 0)
    NK = ExApp.Match("НК", shRep.Rows(1), 0)
    
    
    'перебираем все строки
    For r = 2 To shRep.Cells(shRep.Rows.Count, NK).End(xlUp).Row
        For d = 1 To 3 'из каждой записи делаем 3 новых записи (1,2,3 рабочих дня от даты операции - ожидаемое появление пифа)
            'ключ (НК + тип + дата появляения ПИФа)
            tmpKey = shRep.Cells(r, NK) & "_" & shRep.Cells(r, TP) & "_" & ExApp.WorksheetFunction.WorkDay(shRep.Cells(r, Dt), d) 'можно добавить праздники, нужен список
            If Not dic.Exists(tmpKey) Then 'если ключ не найден
                'добавляем элемент с указанием менеджера (как массив, что бы потом можно было расширить)
                dic.Add tmpKey, Array(shRep.Cells(r, Manager).Value)
            Else
                'если такой ключ уже есть
                If ExApp.IsError(ExApp.Match(shRep.Cells(r, Manager), dic(tmpKey), 0)) Then 'проверяем текущего менеджера в списке менеджеров в массиве
                    'и если такого менеджера там нет
                    tmpArr = dic(tmpKey) 'считываем элемент во временный массив
                    ReDim Preserve tmpArr(UBound(tmpArr) + 1) 'увеличиваем временный массив
                    tmpArr(UBound(tmpArr)) = shRep.Cells(r, Manager).Value 'добавляем текущего менеджера
                    dic(tmpKey) = tmpArr 'и переписываем временный массив обратно в словарь
                End If
            End If
        Next
    Next
    
    Set shResult = wb.Sheets.Add 'создаем новый лист
    For Each tmpKey In dic 'перебираем словарь по ключам
        If UBound(dic(tmpKey)) > 0 Then 'если элемен словаря - это массив с более чем одним элементом
            r = shResult.Cells(shResult.Rows.Count, "A").End(xlUp).Row + 1 'первая незаполненная строка
            With shResult.Range("A" & r & ":C" & r)
                .Value = Split(tmpKey, "_") 'парсим ключ
                .FormulaLocal = .FormulaLocal 'преобразуем НК и дату к числовому виду
            End With
            shResult.Cells(r, "C").NumberFormat = "m/d/yyyy" 'формат даты
            'вставляем менеджеров из массива (диапазон вычисляется исходя из размерности массива)
            shResult.Range(shResult.Range("D" & r), shResult.Range("D" & r).Offset(0, UBound(dic(tmpKey)))) = dic(tmpKey)
        End If
    Next
    
    MsgBox "Done: " & Round(Timer - T, 2)
End Sub