На основании комментария Зоредача, вот мой пример рабочей книги с использованием VBA и расстояния Левенштейна для поиска похожих строк в большом списке.
Он основан на @smirkingman и @ Apostolos55 отвечает на StackOverflow.
Расстояние Левенштейна между двумя словами - это минимальное количество односимвольных правок (вставка, удаление, замена), необходимых для преобразования одного слова в другое.
Я реализовал две разные версии. Пожалуйста, проверьте, какая функция быстрее для вашего случая с 8000 значений. Если вам интересно, посмотрите полный код VBA на Github. Увеличьте порог в строке const treshold = 1 если вы хотите, чтобы результаты с более чем 1 требовали редактирования, чтобы получить совпадение где-либо.
- Синтаксис формулы:
=LevenshteinCompare( <cell_to_check> , <range_to_search_in> )
Пример: =LevenshteinCompare(A2;A$2:A$12) (обратите внимание на фиксированный диапазон)
- Выходной синтаксис:
<number_of_required_edits> - [<match_address>] <match_value>
Private Function Levenshtein(S1 As String, S2 As String)
Dim i As Integer, j As Integer
Dim l1 As Integer, l2 As Integer
Dim d() As Integer
Dim min1 As Integer, min2 As Integer
l1 = Len(S1)
l2 = Len(S2)
ReDim d(l1, l2)
For i = 0 To l1
d(i, 0) = i
Next
For j = 0 To l2
d(0, j) = j
Next
For i = 1 To l1
For j = 1 To l2
If Mid(S1, i, 1) = Mid(S2, j, 1) Then
d(i, j) = d(i - 1, j - 1)
Else
min1 = d(i - 1, j) + 1
min2 = d(i, j - 1) + 1
If min2 < min1 Then
min1 = min2
End If
min2 = d(i - 1, j - 1) + 1
If min2 < min1 Then
min1 = min2
End If
d(i, j) = min1
End If
Next
Next
Levenshtein = d(l1, l2)
End Function
Public Function LevenshteinCompare(S1 As Range, wordrange As Range)
Const treshold = 1
For Each S2 In Application.Intersect(wordrange, wordrange.Parent.UsedRange)
oldRes = newRes
newRes = Levenshtein(S1.Value, S2.Value)
If oldRes < newRes And oldRes <> "" Or S1.Address = S2.Address Then
newRes = oldRes
newS2row = oldS2row
Else
oldS2 = S2
oldS2row = S2.Address(0, 0)
End If
newS2 = oldS2
Next
If newRes <= treshold Then
LevenshteinCompare = newRes & " - [" & newS2row & "] " & newS2
Else
LevenshteinCompare = ""
End If
End Function
Это было весело ☜ (ﾟ ヮ ﾟ ☜)
