=НАИМЕНЬШИЙ(ЕСЛИ($B2=Лист2!$B$2:$B$1000;--ПОДСТАВИТЬ(Лист2!$A$2:$A$1000;".";","));СТОЛБЕЦ(A1))

=НАИМЕНЬШИЙ(ЕСЛИ($B2=Лист2!$B$2:$B$1000;Лист2!$A$2:$A$1000);СТОЛБЕЦ(A1))

Sub t()
     Dim y#(), e()
     a = Range(Sheets(1).[b2], Sheets(1).Cells(Rows.Count, 2).End(xlUp)).Value
     ReDim b(1 To UBound(a), 1 To 4): Set d = CreateObject("scripting.dictionary")
     For Each x In a
         If Not d.exists(x) Then j = j + 1: d.Item(x) = j
     Next
     c = Range(Sheets(2).[a2], Sheets(2).Cells(Rows.Count, 2).End(xlUp)).Value
     For i = 1 To UBound(c)
         If d.exists(c(i, 2)) Then b(d.Item(c(i, 2)), 1) = b(d.Item(c(i, 2)), 1) & "|" & c(i, 1)
     Next
     For i = 1 To j
         x = Split(Mid(b(i, 1), 2), "|"): ReDim y(0 To UBound(x))
         For k = 0 To UBound(x): y(k) = CDbl(x(k)): Next
         For k = 1 To 3: b(i, k + 1) = Application.Small(y, k): Next
     Next
     ReDim e(1 To UBound(a), 1 To 3)
     For i = 1 To UBound(a)
         x = d.Item(a(i, 1)): e(i, 1) = b(x, 2): e(i, 2) = b(x, 3): e(i, 3) = b(x, 4)
     Next
     Sheets(1).[c2].Resize(UBound(a), 3).Value = e
End Sub