求教：为何LevenshteinArray函数会出现数组下标越界错误？

你的Levenshtein距离函数存在两处关键问题，导致无法正确计算字符串相似度，进而影响相似姓名的分组：

原代码的核心问题 #

• 内层循环仅计算了字符匹配的cost值，但完全缺失了Levenshtein距离的核心计算逻辑，没有更新数组来记录当前的距离值。
• 返回语句array2(len1)存在数组越界风险：array2的维度是0 To len2，如果len1 > len2，访问array2(len1)会直接报错，且这也不是正确的最终距离结果。

修复后的完整函数 #

Function LevenshteinArray(ByVal s1 As String, ByVal s2 As String) As Integer
    ' 基于数组优化的Levenshtein距离实现，提升性能
    Dim i As Integer
    Dim j As Integer
    Dim cost As Integer
    Dim len1 As Integer
    Dim len2 As Integer
    Dim prevRow() As Integer
    Dim currRow() As Integer
    
    len1 = Len(s1)
    len2 = Len(s2)
    
    ' 处理其中一个字符串为空的情况
    If len1 = 0 Then
        LevenshteinArray = len2
        Exit Function
    End If
    If len2 = 0 Then
        LevenshteinArray = len1
        Exit Function
    End If
    
    ' 初始化前一行数组
    ReDim prevRow(0 To len1)
    For i = 0 To len1
        prevRow(i) = i
    Next i
    
    ReDim currRow(0 To len1)
    For j = 1 To len2
        currRow(0) = j ' 当前行第一个元素为当前j值
        For i = 1 To len1
            ' 计算字符匹配成本：相同为0，不同为1
            cost = Abs(StrComp(Mid(s1, i, 1), Mid(s2, j, 1), vbTextCompare))
            ' 核心计算：取插入、删除、替换三种操作的最小值
            currRow(i) = WorksheetFunction.Min( _
                prevRow(i) + 1, _          ' 删除操作
                currRow(i - 1) + 1, _      ' 插入操作
                prevRow(i - 1) + cost)     ' 替换操作
        Next i
        ' 将当前行复制到前一行，用于下一轮迭代
        For i = 0 To len1
            prevRow(i) = currRow(i)
        Next i
    Next j
    
    ' 最终距离存放在prevRow的最后一个元素
    LevenshteinArray = prevRow(len1)
End Function

关键修复点说明 #

1. 补全核心计算逻辑：在i循环中加入了Levenshtein距离的核心公式，通过比较插入、删除、替换三种操作的代价，取最小值更新当前行的距离值。
2. 修正数组维度与返回值：使用prevRow和currRow两个长度为len1+1的数组，避免越界问题，最终返回prevRow(len1)作为正确的距离结果。
3. 增加边界处理：提前处理其中一个字符串为空的情况，避免不必要的循环计算。

用于相似姓名分组的使用示例 #

你可以通过遍历姓名数组，计算每对姓名的Levenshtein距离，设定一个阈值（比如2），将距离小于等于阈值的姓名归为一组：

Sub GroupSimilarNames()
    Dim names() As Variant
    Dim i As Integer, j As Integer
    Dim distance As Integer
    Dim threshold As Integer: threshold = 2 ' 可根据需求调整
    
    ' 示例姓名数组
    names = Array("张三", "张珊", "李四", "李肆", "王五")
    
    For i = LBound(names) To UBound(names)
        Debug.Print "与 '" & names(i) & "' 相似的姓名："
        For j = i + 1 To UBound(names)
            distance = LevenshteinArray(names(i), names(j))
            If distance <= threshold Then
                Debug.Print "  - " & names(j) & "（距离：" & distance & "）"
            End If
        Next j
    Next i
End Sub

内容的提问来源于stack exchange，提问作者Nick