El código que planteas va por buen camino, así que aquí te brindo una mano con algunos ajustes sobre él:

    Function DEVUELVE(rango As Range, celda As Range) As Variant
    Dim palabra As Range
    
    For Each palabra In rango.Columns(1).Cells
        If InStr(1, celda.Value, palabra.Value) > 0 Then
            DEVUELVE = Application.WorksheetFunction.VLookup(palabra.Value, rango, 2, False)
            Exit Function
        End If
    Next palabra
    
    DEVUELVE = "???"
    End Function
 
De esta forma, el código va a buscar el texto del segundo argumento de la función en el rango del primer argumento de la misma. Si el hallazgo es verdadero, te va a entregar el valor de la enésima celda de la columna colindante, si no, te va a devolver *'???'*. Llámala usando:

```
=DEVUELVE(rango, palabra)
```