Сравнение текста по части предложения

Option Explicit
Option Compare Text
'---------------------------------------------------------------------------------------
' Procedure : CompareTxt
' DateTime  : 10.03.2015 22:46
' Author    : The_Prist(Щербаков Дмитрий)
'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
'             http://www.excel-vba.ru
' Purpose   : Сравнивает две строки по совпадению отдельных слов. Выводит процент, саму строку и номер строки
'             s1       - исходный текст(ссылка на ячейку или текст)
'             mass     - диапазон значений для сравнения с исходным текстом(ссылка на ячейку или текст)
'             sDelim   - разделитель слов в тексте. По умолчанию пробел
'             lFstLast - указатель, выводить первое или последнее подходящее совпадение.
'                        По умолчанию 0(последнее максимально совпадающее).
'                        Если указать 1 - будет выбрано первое подходящее(в котором совпадают все слова)
'             lShowAllInfo - указатель на результат. Допускается четыре значения:
'                            -1 - показывается вся информация: Процент совпадения строк, Найденное значение,
'                                 Номер строки в указанном диапазоне в которой найдено значение
'                             1 - Выводится только процент совпадения строк
'                             2 - выводится только значение
'                             3 - выводится только номер строки с найденным значением
'                             По умолчанию применяется -1(вся информация)
'             Синтаксис:
'                    =CompareTxt(A1;B1:B100)         - с разделителем по умолчанию
'                    =CompareTxt(A1;B1:B100;"-")     - с разделителем короткое тире(-)
'                    =CompareTxt(A1;B1:B100;"-";;2)  - с разделителем короткое тире(-) и выводом только значения
'---------------------------------------------------------------------------------------
Function CompareTxt(s1 As String, mass As Range, Optional sDelim As String = " ", Optional lFstLast As Long = 0, Optional lShowAllInfo As Long = -1)
    Dim as1, as2, l1 As Long, l2 As Long, lr As Long
    Dim asStr2
    Dim s As String, s2 As String, lp, lTmpCom As Long, lResCom As Long
    Dim lResR As Long, sResS As String, v
 
    as1 = Split(s1, sDelim)
    asStr2 = mass.Value
    If Not IsArray(asStr2) Then ReDim asStr2(1 To 1, 1 To 1): asStr2(1, 1) = mass.Value
 
    For lr = 1 To UBound(asStr2, 1)
        as2 = Split(asStr2(lr, 1), sDelim)
        lResCom = 0
        For l1 = LBound(as1) To UBound(as1)
            s = as1(l1)
            For l2 = LBound(as2) To UBound(as2)
                If as2(l2) = s Then
                    lResCom = lResCom + 1
                    Exit For
                End If
            Next l2
        Next l1
        If lTmpCom < lResCom Then
            lTmpCom = lResCom
            lResR = lr
            sResS = asStr2(lr, 1)
            lp = lp + 1
        End If
        If lFstLast Then
            If lTmpCom >= (UBound(as1) + 1) Then
                Exit For
            End If
        End If
    Next lr
    v = (lTmpCom / (UBound(as1) + 1)) * 100
    Select Case lShowAllInfo
    Case -1
        CompareTxt = "Процент совпадения: " & v & "; Значение: " & sResS & "; Строка в массиве mass: " & lResR
    Case 1 'только процент
        CompareTxt = v
    Case 2 'только значение строки
        CompareTxt = sResS
    Case 3 'только номер строки
        CompareTxt = lResR
    End Select
End Function