Сравнить текст в ячейках excel vba

I think you would be best served using VBA which you could then deploy as a User Defined Function (UDF)

• hold down altf11 to go to the VBE
• Insert … Module
• copy and paste in the code below
• hold down altf11 to go back to Excel

Then call the function in Excel such as
=DupeWord(A1,A2)
to find any matches between A1 and A2

Usr Defined Function

Function DupeWord(str1 As String, str2 As String) As String
Dim vArr1
Dim vArr2
Dim vTest
Dim lngCnt As Long
vArr1 = Split(Replace(str1, " ", vbNullString), ",")
vArr2 = Split(Replace(str2, " ", vbNullString), ",")
On Error GoTo strExit

For lngCnt = LBound(vArr1) To UBound(vArr1)
vTest = Application.Match(vArr1(lngCnt), vArr2, 0)
If Not IsError(vTest) Then DupeWord = DupeWord & vArr1(lngCnt) & ", "
Next lngCnt
If Len(DupeWord) > 0 Then
DupeWord = Left$(DupeWord, Len(DupeWord) - 2)
Else
strExit:
DupeWord = "No Matches!"
End If

End Function

Use inside VBA

Sub test()
MsgBox DupeWord("dog, cat, rabbit, mouse, lion, bear, tiger", "sausage, pickle, dog, cat, elephant, bread")
End Sub

Хитрости »

12 Апрель 2015              30620 просмотров

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

Довольно часто возникает проблема сравнения двух строк(ячеек) по части текста. Если точнее — по совпадению слов. Чем больше слов в двух строках совпадает — тем больше они считаются похожими. Так, к примеру текст «Защитная пленка 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, 3 594 скачиваний)

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика