Excel VBA, своего рода нечеткое совпадение

Question

Я хочу автоматизировать скрипт в Excel VBA, и я застрял.

У меня есть строка = «Население пациентов - х. Из-за этого многие пациенты - мужчины. У конкретного мужского патини есть 3 смертельных заболевания». (строки будут длиннее)

Теперь, что я хочу сделать, это поиск, сколько раз слово «пациент» появляется в этой строке, даже если слова имеют проблемы с заклинаниями и как они записываются.

Мое идее должно было сказать совпадение с доверием 80% слова «пациент» со всеми словами в строке, и результат, на который я нацелился, - это ... есть 3 матча и слова, которые в строке: «пациент», «пациенты», «патин». Есть ли способ сделать это?

Answer 1

Концепция, которую вы ищете, называется «полнотекстовый поиск».

Я не уверен на 100%, но я думаю, что это не родной язык в Excel или VBA. Насколько мне известно, MS Access не поддерживает это.

Ознакомьтесь с надстройкой, предложенной Alex K, или рассмотрите возможность внедрения реальной базы данных в ваше приложение.

Answer 2

YMMV, конечно, но две вещи, чтобы посмотреть на это:

Fuzzy Lookup Add-In for Excel

... выполняет нечеткого соответствия текстовых данных в Microsoft Excel. Он может использовать для идентификации нечетких повторяющихся строк в одной таблице или до нечетких соединений аналогичных строк между двумя разными таблицами. Согласование - это , устойчивое к широкому спектру ошибок, включая орфографические ошибки, аббревиатуры, синонимы и добавленные/отсутствующие данные, .

Расчет Levenshtein Distance также может быть полезен.

Answer 3

Здесь представлена ​​версия VBA для левеншинского расстояния. Вы можете настроить порог в соответствии с вашими потребностями.

Public Function Levenshtein(str1 As String, str2 As String) As Integer 
On Error GoTo ErrHandler 
    Dim arrLev, intLen1 As Integer, intLen2 As Integer, i As Integer 
    Dim j, arrStr1, arrStr2, intMini As Integer 

    intLen1 = Len(str1) 
    ReDim arrStr1(intLen1 + 1) 
    intLen2 = Len(str2) 

    ReDim arrStr2(intLen2 + 1) 
    ReDim arrLev(intLen1 + 1, intLen2 + 1) 

    arrLev(0, 0) = 0 
    For i = 1 To intLen1 
     arrLev(i, 0) = i 
     arrStr1(i) = Mid(str1, i, 1) 
    Next 

    For j = 1 To intLen2 
     arrLev(0, j) = j 
     arrStr2(j) = Mid(str2, j, 1) 
    Next 

    For j = 1 To intLen2 
     For i = 1 To intLen1 
      If arrStr1(i) = arrStr2(j) Then 
       arrLev(i, j) = arrLev(i - 1, j - 1) 
      Else 
       intMini = arrLev(i - 1, j) 'deletion 
       If intMini > arrLev(i, j - 1) Then intMini = arrLev(i, j - 1) 'insertion 
       If intMini > arrLev(i - 1, j - 1) Then intMini = arrLev(i - 1, j - 1) 'deletion 

       arrLev(i, j) = intMini + 1 
      End If 
     Next 
    Next 

    Levenshtein = arrLev(intLen1, intLen2) 
    Exit Function 

ErrHandler: 
    MsgBox Err.Description 
    Exit Function 
End Function 

Answer 4

Вы можете использовать алгоритм Soundex2 для соответствия аналогичным словам. This SO post имеет несколько указателей на soundex в VBA.
Обратите внимание, что алгоритм основан на характеристиках, преимущественно используемых на английском языке.