Sub Macro1()
Dim LastRow As Long, i As Long, j As Long, Arr(), Arr2()
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Arr = Range(Cells(2, 2), Cells(LastRow, 3)).Value
    With Sheets("Основа")
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Arr2 = Range(.Cells(2, 2), .Cells(LastRow, 2)).Value
        For i = 1 To UBound(Arr)
            For j = 1 To UBound(Arr2)
                If Arr2(j, 1) = Arr(i, 1) Then
                    Arr(i, 2) = j + 1
                    Exit For
                End If
            Next
        Next
    End With
    Range("B2").Resize(UBound(Arr), 2).Value = Arr
End Sub