Option Explicit

Function probook(s As String, r, ParamArray Rubbish()) As String
    Dim a, el, t$, tt$, i&, flag As Boolean

    s = " " & UCase(s) & " "
    For Each el In Rubbish
        s = Replace(s, " " & UCase(el) & " ", " ", , , vbTextCompare)
    Next

    a = Split(Application.Trim(s))
    r = Intersect(r.Parent.UsedRange, r).Value
    For i = 1 To UBound(r)
        t = " " & r(i, 1) & " "
        t = Replace(UCase(t), "-", " ")
        t = Replace(t, "CORE", " ")    'спасаю одну позицию, думаю не помешает
        t = rus2eng(t)
        flag = True
        For Each el In a
            If InStr(t, UCase(" " & el & " ")) = 0 Then flag = False: Exit For
        Next
        If flag Then tt = tt & "/" & r(i, 2)
    Next
    If Len(tt) Then probook = Mid(tt, 2)
End Function

Private Function rus2eng(s$)
    Dim arrEng, arrRus, i&

    arrRus = Split("М Т О Н А Е Р С К В")
    arrEng = Split("M T O H A E P C K B")
    For i = 0 To UBound(arrRus)
        s = Replace(s, arrRus(i), arrEng(i))
    Next
    rus2eng = s
End Function