Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Application.ScreenUpdating = False
 With Worksheets("Лист2")
   iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   For i = 2 To iLastRow
     .Cells(i, "D") = .Cells(i, "A") & "|" & .Cells(i, "B")
   Next
     iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For i = 2 To iLastRow
    Set FoundCell = .Columns("D").Find(Cells(i, "A") & "|" & Cells(i, "B"), , xlValues, xlWhole)
    If Not FoundCell Is Nothing Then
      Cells(i, "C") = .Cells(FoundCell.Row, "C")
    End If
  Next
    .Columns("D").Delete
 End With
Application.ScreenUpdating = True
End Sub