Option Explicit

' 计算两个字符串的相似度

Public Function CalculateSimilarity(ByVal str1 As String, ByVal str2 As String) As Double

    Dim distance As Integer

    Dim maxLength As Integer

    Dim similarity As Double '获取两个字符串的编辑距离

    distance = EditDistance(str1, str2) '获取较长字符串的长度

    maxLength = IIf(Len(str1) > Len(str2), Len(str1), Len(str2)) '计算相似度

    similarity = 1 - (distance / maxLength)    

    CalculateSimilarity = similarity

End Function

' 计算两个字符串的编辑距离

Private Function EditDistance(ByVal str1 As String, ByVal str2 As String) As Integer

    Dim len1 As Integer

    Dim len2 As Integer

    Dim matrix() As Integer

    Dim i As Integer

    Dim j As Integer

    Dim cost As Integer    

    len1 = Len(str1)

    len2 = Len(str2)    

    ReDim matrix(len1, len2) '初始化矩阵

    For i = 0 To len1

        matrix(i, 0) = i

    Next    

    For j = 0 To len2

        matrix(0, j) = j

    Next '计算编辑距离

    For i = 1 To len1

        For j = 1 To len2

            If Mid(str1, i, 1) = Mid(str2, j, 1) Then

                cost = 0

            Else

                cost = 1

            End If

            matrix(i, j) = Min3(matrix(i - 1, j) + 1, matrix(i, j - 1) + 1, matrix(i - 1, j - 1) + cost)

        Next

    Next '返回编辑距离

    EditDistance = matrix(len1, len2)

End Function

' 返回三个数中的最小值

Private Function Min3(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer) As Integer

    Dim min As Integer    

    min = a    

    If b < min Then

        min = b

    End If    

    If c < min Then

        min = c

    End If    

    Min3 = min

End Function