==IFERROR(INDEX(Учет!G$2:G$100;AGGREGATE(15;6;ROW($1:$100)/(B$2=Учет!D$2:D$100)/(B$3=Учет!E$2:E$100)/(B$4=Учет!F$2:F$100);ROWS($2:2)));"")

=IF(E2<>"";ROWS($2:2);"")

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B2:B4")) Is Nothing Then
    Dim arr, arr2, arr3, arr4, i As Long, n As Long, lr As Long, lr2 As Long, k As Long
    Dim sh As Worksheet
    Set sh = Worksheets("Учет")
    lr = sh.Cells(Rows.Count, 7).End(xlUp).Row
    arr = sh.Range("A2:G" & lr)
    arr2 = Range("B2:B4")
    ReDim arr3(1 To UBound(arr), 1 To 2): k = 1
        If arr2(1, 1) = Empty Then x1 = "" Else x1 = arr2(1, 1)
        If arr2(2, 1) = Empty Then x2 = "" Else x2 = arr2(2, 1)
        If arr2(3, 1) = Empty Then x3 = "" Else x3 = arr2(3, 1)
        X = LCase(x1 & x2 & x3)
    For i = LBound(arr) To UBound(arr)
        If x1 = "" Then x1 = x11 Else x11 = arr(i, 4)
        If x2 = "" Then x2 = x22 Else x22 = arr(i, 5)
        If x3 = "" Then x3 = x33 Else x33 = arr(i, 6)
        XX = LCase(x11 & x22 & x33)
        If X = XX Then
            arr3(k, 1) = k
            arr3(k, 2) = arr(i, 7)
            k = k + 1
        End If
    Next i
    Range("D2:E" & Cells(Rows.Count, 4).End(xlUp).Row + 1).Clear
    Range("D2").Resize(UBound(arr3), 2) = arr3
End If
End Sub