找到一个单词和数千个数组之间的最小 Levenshtein 距离答案

【问题标题】：Find minimum Levenshtein Distance between one word and an array of thousands找到一个单词和数千个数组之间的最小 Levenshtein 距离
【发布时间】：2018-10-11 17:51:47
【问题描述】：

所以我的用户在注册表中写下了他们的地址，但其中很多人都有拼写错误。我从城市记录中检索到另一个列表，其中这些地址的拼写正确。所以假设我有他们输入的“Brooklny”，我有正确名称的列表：布鲁克林、曼哈顿、布朗克斯、史泰登岛、皇后区（这是一个例子，实际地址是西班牙语，指的是墨西哥城的社区） .

我想找到布鲁克林和每个行政区名称之间的编辑距离，然后找到布鲁克林具有最小编辑距离的单词。

所以编辑之间的距离：Brooklny-Brooklyn 为 2，Brooklny-Bronx 为 4，依此类推。当然，布鲁克林的最低要求是 2。

想象一下，布鲁克林在 A1 单元格中，布鲁克林、曼哈顿、布朗克斯、史泰登岛和皇后区分别在 B1:B6 的单元格中

我在 VBA 中为 Excel 中的用户定义函数执行此操作，到目前为止我有此代码，但它不起作用。

Function Minl(ByVal string1 As String, ByVal correctos As Range) As Variant

Dim distancias(3) As Integer
Dim i, minimo As Integer
i = 0
For Each c In correctos.Cells
    distancias(i) = Levenshtein(string1, c.Value)
    i = i + 1
Next c

Minl = Minrange(distancias)

End Function

Function Levenshtein(ByVal string1 As String, ByVal string2 As String) As Long

Dim i As Long, j As Long
Dim string1_length As Long
Dim string2_length As Long
Dim distance() As Long

string1_length = Len(string1)
string2_length = Len(string2)
ReDim distance(string1_length, string2_length)

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
        If Asc(Mid$(string1, i, 1)) = Asc(Mid$(string2, j, 1)) Then
            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)
        End If
    Next
Next

Levenshtein = distance(string1_length, string2_length)

End Function

Function Minrange(ParamArray values() As Variant) As Variant
Dim minValue, Value As Variant
minValue = values(0)
For Each Value In values
   If Value < minValue Then minValue = Value
Next
Minrange = minValue
End Function

我认为算法是正确的，但我认为我的语法可能有问题。 levenshtein 函数有效，但我不确定其他两个。

【问题讨论】：

标签： excel vba nlp levenshtein-distance edit-distance

【解决方案1】：

要获得最接近的输出，您可以使用：

Function get_match(ByVal str As String, rng As Range) As String
  Dim itm As Variant, outp(0 To 2) As Variant
  outp(1) = 0: outp(2) = ""
  For Each itm In rng.Text
    outp(0) = Levenshtein(itm, str)
    If outp(0) = 0 Then
      get_match = itm
      Exit Function
    ElseIf outp(1) = 0 Or outp(0) < outp(1) Then
      outp(1) = outp(0)
      outp(2) = itm
    End If
  Next
  get_match = outp(1)
End Function

要稍后获得距离，您只需运行 Levenshtein(string,get_match(string,range))

仍然...我不确定您在寻找什么：/

【讨论】：