Basierend auf Zoredaches Kommentar ist hier meine Beispielarbeitsmappe mit VBA und Levenshtein Distance , um ähnliche Zeichenfolgen in einer großen Liste zu finden. Es basiert auf den Antworten von @smirkingman und @ Apostolos55 zum Stackoverflow .
Der Levenshtein-Abstand zwischen zwei Wörtern ist die Mindestanzahl von Einzelzeichenänderungen (Einfügen, Löschen, Ersetzen), die erforderlich sind, um ein Wort in das andere zu ändern
Ich habe zwei verschiedene Versionen implementiert. Bitte überprüfen Sie, welche Funktion für Ihren Fall mit 8000 Werten schneller ist. Wenn Sie neugierig sind, sehen Sie sich den vollständigen VBA- Code auf Github an . Erhöhen Sie den Schwellenwert in der Zeile, const treshold = 1
wenn Sie Ergebnisse mit mehr als einer erforderlichen Bearbeitung wünschen, um irgendwo eine Übereinstimmung zu erzielen.
- Formelsyntax:
=LevenshteinCompare( <cell_to_check> , <range_to_search_in> )
Beispiel: =LevenshteinCompare(A2;A$2:A$12)
(Beachten Sie den festen Bereich)
- Ausgabesyntax:
<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
Das hat Spaß gemacht ☜ (゚ ヮ ゚ ☜)