Совпадение текста vba excel

Хитрости »

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

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

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

Based on Ahmed’s answer, after some cleaning up and generalization, including the other «Find» parameters, so we can use this function in any situation:

'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
    Dim SearchResult As Range
    Dim firstMatch As String
    With rng
        Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
        If Not SearchResult Is Nothing Then
            firstMatch = SearchResult.Address
            Do
                If FindAll Is Nothing Then
                    Set FindAll = SearchResult
                Else
                    Set FindAll = Union(FindAll, SearchResult)
                End If
                Set SearchResult = .FindNext(SearchResult)
            Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
        End If
    End With
End Function

Usage is the same as native .Find, but here is a usage example as requested:

Sub test()
  Dim SearchRange As Range, SearchResults As Range, rng As Range
    Set SearchRange = MyWorksheet.UsedRange
    Set SearchResults = FindAll(SearchRange, "Search this")
    
    If SearchResults Is Nothing Then
        'No match found
    Else
        For Each rng In SearchResults
            'Loop for each match
        Next
    End If
End Sub

INSTR Function

The VBA Instr Function checks if a string of text is found in another string of text.  It returns 0 if the text is not found. Otherwise it returns the character position where the text is found.

The Instr Function performs exact matches. The VBA Like Operator can be used instead to perform inexact matches / pattern matching by using Wildcards.

Instr Example

The following code snippet searches the string “Look in this string” for the word “Look”. The Instr Function returns 1 because the text is found in the first position.

Sub FindSomeText()
  MsgBox InStr("Look in this string", "Look")
End Sub

This second example returns 7 because the text is found starting in the 7th position:

Sub FindSomeText2()
  MsgBox InStr("Don't Look in this string", "Look")
End Sub

Important! The Instr Function is case-sensitive by default. This means “look” will not match with “Look”. To make the test case-insensitive read below.

Instr Syntax

The syntax for the Instr function is as follows:

Instr( [start], string, substring, [compare] )

[start] (optional) – This optional argument is the starting position of the search. Enter 1 to start searching from position 1 (or leave blank). Enter 5 to start searching from position 5. Important! The INSTR function calculates the character position by counting from 1 NOT from the [start] position.

string – The string of text to search in.

substring – The string of text to find in the primary string.

[compare] (optional) – By default, Instr is case-sensitive. By setting this argument you can make Instr Case insensitive:

Instr Start Position

The Instr start position allows you to indicate the character position where you will begin your search.  Keep in mind however, the Instr output will always count from 1.

Here we set the start position to 3 to skip the first B:

Sub Instr_StartPosition()
  MsgBox InStr(3, "ABC ABC", "B")
End Sub

The result is 6 because the second B is the 6th character in the string.

Case-Insensitive INSTR Test

By default, VBA treats “L” different from “l”. In other words, VBA is case-sensitive. This is true of all text functions.  To make VBA case-insensitive, set the [compare] argument to 1 or vbTextCompare.

Public Sub FindText_IgnoreCase()
  MsgBox InStr(1, "Don't Look in this string", "look", vbTextCompare)
End Sub

Alternatively, you can add Option Compare Text to the top of your code module:

Option Compare Text

Option Compare Text

Public Sub FindText_IgnoreCase2()
  MsgBox InStr("Don't Look in this string", "look")
End Sub

Option Compare Text will impact all of the code in that module. I personally place this at the top of any module that deals with text because I never care about case differences.

InstrRev Function

The Instr Function searches from the left. Instead you can search from the right using the InstrRev Function.  The InstrRev Function works very similarly to the Instr function.

Sub FindSomeText_FromRight()
  MsgBox InStrRev("Look in this string", "Look")
End Sub

Just like the Instr function this will return 1 because there is only one instance of “Look” in the text. But if we add a second “Look”, you’ll see that it returns the position of the right-most “Look”:

Sub FindSomeText_FromRight()
  MsgBox InStrRev("Look in this string Look", "Look")
End Sub

Next we will review more Instr examples.

InString Examples

If String Contains Substring

Here we will use an If statement to test if a string contains a a substring of text:

Public Sub FindSomeText()

If InStr("Look in this string", "look") = 0 Then
   MsgBox "No match"
Else
   MsgBox "At least one match"
End If

End Sub

Find Text String in a Cell

You can also find a string in a cell:

Sub Find_String_Cell()
    If InStr(Range("B2").Value, "Dr.") > 0 Then
        Range("C2").Value = "Doctor"
    End If
End Sub

Or loop through a range of cells to test if the cells contain some text:

Sub Search_Range_For_Text()
Dim cell As Range

    For Each cell In Range("b2:b6")
        If InStr(cell.Value, "Dr.") > 0 Then
            cell.Offset(0, 1).Value = "Doctor"
        End If
    Next cell
    
End Sub

VBA Programming | Code Generator does work for you!

Find Position of a Character in a String

This code will find the position of a single character in a string and assign the position to a variable:

Sub Find_Char()
  Dim n As Long
  n = InStr("Here Look Here", "L")
End Sub

Search String for Word

This code will search a string for a word:

Sub Search_String_For_Word()
    Dim n As Long
    n = InStr("Here Look Here", "Look")
  
    If n = 0 Then
        MsgBox "Word not found"
    Else
        MsgBox "Word found in position: " & n
    End If
End Sub

If Variable Contains String

This code will test if a string variable contains a string of text:

Sub Variable_Contains_String()
    Dim str As String
    str = "Look Here"
    
    If InStr(str, "Here") > 0 Then
        MsgBox "Here found!"
    End If
End Sub

Instr and the Left Function

Instr can be used along with other text functions like Left, Right, Len, and Mid to trim text.

With the Left function you can output the text prior to a string of text:

Sub Instr_Left()
    Dim str As String
    Dim n As Long
    
    str = "Look Here"
    
    n = InStr(str, "Here")
    
    MsgBox Left(str, n - 1)

End Sub

Using Instr in Microsoft Access VBA

All of the above examples work exactly the same in Access VBA as in Excel VBA.

To learn more, read our article: VBA text functions

<<Return to VBA Examples