Function realfind(ByVal what As Range, ByVal where As Range)
    what_arr = Split(cleanup(what), " ";)
    ReDim rezult(1 To where.Rows.Count)
    For i = LBound(rezult) To UBound(rezult)
        For n = LBound(what_arr) To UBound(what_arr)
        
            fnd = InStr(1, where(i, 1), what_arr(n), vbTextCompare)
            If fnd > 0 Then rezult(i) = rezult(i) + 1
        Next n
    Next i
    rez = rezult(LBound(rezult))
    For i = LBound(rezult) To UBound(rezult)
        If rezult(i) > rez Then rez = rezult(i): realfind = i
    Next i
realfind = where(realfind, 1)
End Function

Private Function cleanup(what)
    Set re = CreateObject("vbscript.regexp";)
    re.Global = True
    re.Pattern = "[^\dA-Za-z]"
    cleanup = Application.Trim(re.Replace(what, " ";))
End Function