Hallo zusammen,

Ich stehe vor einem Problem. Vllt. kann mir einer weiterhelfen.

Ich möchte eine Art fuzzy search in VBA umsetzen. Die Idee ist 2 Strings miteinander zu vergleichen und die Levenshtein distance auszugeben. Bei einem Abgleich von 2 Strings ist das kein Problem. String 1 vergleichen mit String A.

Nun ist es so, dass ich einen String 1 mit einer Vielzahl von Strings (A,B,C,D,etc.) abgleichen und mir den Wert mit der geringsten Levenshtein distance ausgeben möchte.

String 1 = (String A, String B, String C, String D, etc.)

String 2 = (String A, String B, String C, String D, etc.)

String 3 = (String A, String B, String C, String D, etc.)

Der String (A;B;C;D,etc.) mit der geringsten Levenshtein distance soll dann ausgegeben werden. Im besten Fall noch zusätzlich den Wert der Levenshtein distance.

Eine Funktion/code der Levenshtein distance habe ich bereits (findet man einfach mit ein bisschen Suchen).

Mein Anatz wäre nun:

• Die abzugleichen Strings (A,B,C,D,etc.) in ein array schreiben (die sollen nicht angepasst werden)
• Dann einen Abgleich für jeden String, Zeile für Zeile durchführen (String 1,2,3)
• Den Wert mit der geringsten Levenshtein distance ausgeben (neben den String 1,2,3) schreiben
• Wenn es mehrere Treffer für die geringste Levenshtein distance gibt dann alle ausgeben 

Zielbild:

Beispiel einer Funktion:

Option Explicit
Public Function Levenshtein(s1 As String, s2 As String)

Dim i As Integer
Dim j As Integer
Dim l1 As Integer
Dim l2 As Integer
Dim d() As Integer
Dim min1 As Integer
Dim 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

Ich hoffe ich habe mein Problem verständlich beschrieben.

Über jegliche Hilfe bin ich mehr als dankbar!

Beste Grüße und vielen Dank schon einmal.

Tom