forum.boolean.name - Неточное сравнение текста

Дарова, булка :)
Пишу скрипт неточного сравнения строк, типа как в поисковиках используется, например, чтобы пользователь вводил в базу "Зеленая петрушка", а скрипт ему: - ты чо, дурак, вот в базе уже есть "Зелень: Петрушка". Чужие алгоритмы не разбирал, ибо больше времени уйдёт, пока разберусь в чужом коде.
Начал думать свой алгоритм...прикинул так: разбивать текст на слова и по 2 символа сравнивать, например, "зе-ле-на-я" + "пе-тр-уш-ка" AND "зе-ле-нь" + "пе-тр-уш-ка" ...и второй проход со смещением на 1 символ: "ел-ен-ая" + "ет-ру-шк-а" AND "ел-ен-ь" + "ет-ру-шк-а" а потом подсчитывать процент совпадения.
В общем вроде работает, но большой процент ошибок...посоветуйте на пальцах как доработать код, может добавить проверку по 3 символа, чтобы точнее работало? тока не надо чужой код, лучше посоветуйте на словах :rolleyes:
Вот сам код, пишу пока на vba, т.к. база продуктов в экселе:

Код:

Public scan1, scan2, x

Public Const di11 = 3, di12 = 87, di21 = 96, di22 = 199 ' диапазон для сравнения

Public search(di11 To di12, di21 To di22) As Integer



Sub win(): Erase search()



For x = di11 To di12



a = LCase(Cells(x, 1))



' если в первой строке 2 слова, то разделяем их на a1 и a2:

If InStr(a, " ") <> 0 Then

  a1 = Left(a, InStr(a, " ") - 1)

  a2 = Right(a, Len(a) - InStr(a, " "))

  Else: a1 = a: a2 = ""

End If



' первый проход для a1

While Not exit_ = 1

    scan1 = Left(a1, 2)

    sli = b_search()

    If Len(a1) > 2 Then a1 = Right(a1, Len(a1) - 2) Else exit_ = 1

Wend: exit_ = 0



If a2 <> "" Then

  a1 = Left(a, InStr(a, " ") - 1)

  Else: a1 = a

End If

        

' второй проход со смещением -1 для a1

a1 = Right(a1, Len(a1) - 1)

While Not exit_ = 1

    scan1 = Left(a1, 2)

    sli = b_search()

    If Len(a1) > 2 Then a1 = Right(a1, Len(a1) - 2) Else exit_ = 1

Wend: exit_ = 0



If a2 <> "" Then

  a1 = Left(a, InStr(a, " ") - 1)

  Else: a1 = a

End If



If a2 <> "" Then



' первый проход для a2

While Not exit_ = 1

    scan1 = Left(a2, 2)

    sli = b_search()

    If Len(a2) > 2 Then a2 = Right(a2, Len(a2) - 2) Else exit_ = 1

Wend: exit_ = 0: a2 = Right(a, Len(a) - InStr(a, " "))



' второй проход со смещением -1 для a2

a2 = Right(a2, Len(a2) - 1)

While Not exit_ = 1

    scan1 = Left(a2, 2)

    sli = b_search()

    If Len(a2) > 2 Then a2 = Right(a2, Len(a2) - 2) Else exit_ = 1

Wend: exit_ = 0: a2 = Right(a, Len(a) - InStr(a, " "))



End If



Next



For x = di11 To di12

  For y = di21 To di22

    If search(x, y) >= 2 Then

        

        a = Cells(x, 1): b = Cells(y, 1)

        

        If Len(a) >= Len(b) Then ' находим самую короткую из 2х сравниваемых строк

          mini = Len(b)

        Else: mini = Len(a)

        End If

        

        If search(x, y) > mini Then search(x, y) = mini ' совпадений не может быть больше, чем символов

    

        proc = (100 / mini) * search(x, y) ' считаем процент совпадений

    

        If a = b Then

          proc = 100

        ElseIf proc > 95 Then proc = 95 ' всегда есть шанс на ошибку (:

        End If

        

    

    If proc > 70 Then MsgBox Cells(x, 1) + " = " + Cells(y, 1) & vbNewLine & "Вероятность = " + Str(proc) + "%"

    End If

  Next

Next





End Sub





Function b_search()

 

  For y = di21 To di22

      

      b = LCase(Cells(y, 1))

      

      ' если в первой строке 2 слова, то разделяем их на b1 и b2:

      If InStr(b, " ") <> 0 Then

          b1 = Left(b, InStr(b, " ") - 1)

          b2 = Right(b, Len(b) - InStr(b, " "))

          Else: b1 = b: b2 = ""

      End If

      

      'первый проход для b1

      While Not exit_ = 1

          scan2 = Left(b1, 2)

          If scan1 = scan2 Then search(x, y) = search(x, y) + 1

          If Len(b1) > 2 Then b1 = Right(b1, Len(b1) - 2) Else exit_ = 1

      Wend: exit_ = 0

      

      If b2 <> "" Then

          b1 = Left(b, InStr(b, " ") - 1)

          Else: b1 = b

      End If

      

      ' второй проход со смещением -1 для b1

      b1 = Right(b1, Len(b1) - 1)

      While Not exit_ = 1

          scan2 = Left(b1, 2)

          If scan1 = scan2 Then search(x, y) = search(x, y) + 1

          If Len(b1) > 2 Then b1 = Right(b1, Len(b1) - 2) Else exit_ = 1

      Wend: exit_ = 0

      

      If b2 <> "" Then

          b1 = Left(b, InStr(b, " ") - 1)

          Else: b1 = b

      End If

      

    If b2 <> "" Then



      ' первый проход для b2

      While Not exit_ = 1

          scan2 = Left(b2, 2)

          If scan1 = scan2 Then search(x, y) = search(x, y) + 1

          If Len(b2) > 2 Then b2 = Right(b2, Len(b2) - 2) Else exit_ = 1

      Wend: exit_ = 0: b2 = Right(b, Len(b) - InStr(b, " "))



      ' второй проход со смещением -1 для b2

      b2 = Right(b2, Len(b2) - 1)

      While Not exit_ = 1

          scan2 = Left(b2, 2)

          If scan1 = scan2 Then search(x, y) = search(x, y) + 1

          If Len(b2) > 2 Then b2 = Right(b2, Len(b2) - 2) Else exit_ = 1

      Wend: exit_ = 0: b2 = Right(b, Len(b) - InStr(b, " "))

    End If



    Next

    

End Function

А вот результат удачной работы, но ошибается пока очень часто