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

Довольно часто возникает проблема сравнения двух строк(ячеек) по части текста. Если точнее - по совпадению слов. Чем больше слов в двух строках совпадает - тем больше они считаются похожими. Так, к примеру текст "Защитная пленка iPhone" и текст "Защитная пленка для Samsung GalaxyII" совпадут только на 40%, а "шла маша по шоссе" и "маша по шоссе шла" - на 100%.
Я не имею ввиду сейчас случаи вроде двух строк: "привет" и "превет". Для подобного сравнения можно написать решения различные, но скорость их выполнения как правило оставляет желать лучшего, да и точность такого сравнения тоже не на высоте, если не использовать всевозможные справочники
На деле подобная задача встречается достаточно часто и предположу, что данная статья может быть полезна очень многим. Итак, как ни жаль, но подобную задачу невозможно решить без применения Visual Basic for Applications(VBA). Решение, которое я предложу - функция пользователя. Поэтому прежде чем его использовать настоятельно рекомендую прочесть следующие статьи:

• Что такое функция пользователя(UDF)? - обязательно
• Почему не работает макрос? - обязательно
• Что такое макрос и где его искать? - не помешает
• Что такое модуль? Какие бывают модули? - не помешает

Собственно сам код функции:

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

Данный код необходимо вставить в стандартный модуль книги(выше я привел ссылки на статьи, чтобы более точно понять куда и как вставить). Функция ищет указанное значение(s1) в массиве значений(mass) и выводит максимально подходящее значение. Максимально подходящее, естественно, полное совпадение - то, которое совпадает на 100%. Если же полного совпадения среди значений массива(mass) не будет найдено, то будет выведено значение с максимальным процентом совпадения. В таких случаях всегда можно указать последним аргументом(lShowAllInfo) -1 или 3, чтобы посмотреть номер строки в указанном диапазоне(mass) и сверить уже глазами подходит это значение или нет.
Синтаксис:
=CompareTxt(A1;B1:B100) - с разделителем по умолчанию
=CompareTxt(A1;B1:B100;"-") - с разделителем короткое тире(-)
=CompareTxt(A1;B1:B100;"-";;2) - с разделителем короткое тире(-) и выводом только значения
Аргументы:
s1 - исходный текст(ссылка на ячейку или текст)
mass - диапазон значений для сравнения с исходным текстом(ссылка на ячейку или текст)
sDelim - разделитель слов в тексте. По умолчанию пробел.
lFstLast - указатель, выводить первое или последнее подходящее совпадение. По умолчанию 0(последнее максимально совпадающее). Если указать 1 - будет выбрано первое подходящее(в котором совпадают все слова)
lShowAllInfo - указатель на результат. Допускается четыре значения:

• -1 - показывается вся информация: Процент совпадения строк, Найденное значение, номер строки в указанном диапазоне в которой найдено значение
• 1 - Выводится только процент совпадения строк
• 2 - выводится только значение
• 3 - выводится только номер строки с найденным значением. По умолчанию применяется -1(вся информация)

Ниже функция в файле с примерами использования:

  Tips_Macro_ComparePart.xls (50,5 KiB, 1 220 скачиваний)