MyTetra Share
Делитесь знаниями!
Сравнение текста по части предложения
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Text
Запись: xintrea/mytetra_db_adgaver_new/master/base/1514992476ad79l1qhrp/text.html на raw.githubusercontent.com

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

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


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

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


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 скачиваний)

Прикрепленные файлы:
Так же в этом разделе:
 
MyTetra Share v.0.59
Яндекс индекс цитирования