Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.06.2020, 15:44   #1
Azrailll
Новичок
Джуниор
 
Регистрация: 22.02.2020
Сообщений: 1
По умолчанию Нечеткий поиск в документе

Добрый день, форумчане.
Подскажите, пожалуйста, как реализовать поиск ближайшего похожего текста в документе Word.
Есть предложение которое нужно найти в документе. Н-р, "Маша ела кашу".
Есть документ с текстом, где слова из этого предложения встречаются, но не на 100%.
Для простоты посчитаем, что одно предложение в каждом абзаце.
Цитата:
Маша ела кашу днем.
Ела кашу Вера.
Паша ел суп.
Соответственно, нужно найти самое похожее, т.е. первое предложение и скопировать из него текст.
Погуглив, нашел реализацию наиболее популярного алгоритма такого нечеткого сравнения (расстояние Левенштейна) на VB.
Код:
  Public Function levenshtein(ByVal string1 As String, ByVal string2 As String) As Long
 
  Dim i As Long, j As Long, bs1() As Byte, bs2() As Byte
  Dim string1_length As Long
  Dim string2_length As Long
  Dim distance() As Long
  Dim min1 As Long, min2 As Long, min3 As Long
 
  string1_length = Len(string1)
  string2_length = Len(string2)
  ReDim distance(string1_length, string2_length)
  bs1 = string1
  bs2 = string2
 
  For i = 0 To string1_length
      distance(i, 0) = i
  Next
 
  For j = 0 To string2_length
      distance(0, j) = j
  Next
 
  For i = 1 To string1_length
      For j = 1 To string2_length
          'slow way: If Mid$(string1, i, 1) = Mid$(string2, j, 1) Then
          If bs1((i - 1) * 2) = bs2((j - 1) * 2) Then   ' *2 because Unicode every 2nd byte is 0
              distance(i, j) = distance(i - 1, j - 1)
          Else
              'distance(i, j) = Application.WorksheetFunction.Min _
              (distance(i - 1, j) + 1, _
               distance(i, j - 1) + 1, _
               distance(i - 1, j - 1) + 1)
              ' spell it out, 50 times faster than worksheetfunction.min
              min1 = distance(i - 1, j) + 1
              min2 = distance(i, j - 1) + 1
              min3 = distance(i - 1, j - 1) + 1
              If min1 <= min2 And min1 <= min3 Then
                  distance(i, j) = min1
              ElseIf min2 <= min1 And min2 <= min3 Then
                  distance(i, j) = min2
              Else
                  distance(i, j) = min3
              End If
 
          End If
      Next
  Next
 
  levenshtein = distance(string1_length, string2_length)
 
  End Function
 
MsgBox levenstein("папа", "мама")
Но как это все применить к моему запросу? Или, возможно, есть способ проще?
Azrailll вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нечеткий поиск fakel-v БД в Delphi 0 28.02.2012 21:29
Нечеткий поиск на основе сетей Хемминга rust09reg91 Общие вопросы Delphi 0 09.04.2011 13:45
Поиск в текстовом документе. nolz Помощь студентам 1 07.12.2009 19:37
Поиск текста в документе haros Общие вопросы Delphi 0 28.07.2009 18:52
Поиск между символами в документе viter.alex Microsoft Office Word 7 24.05.2009 20:00