效果1:
去掉字符串中回车，进行改进后效果：
代码：
Function LevenshteinDistance(s As String, t As String) As IntegerDim d() As IntegerDim i As IntegerDim j As IntegerDim cost As IntegerDim sLen As IntegerDim tLen As IntegersLen = Len(s)tLen = Len(t)ReDim d(sLen, tLen)For i = 0 To sLend(i, 0) = iNext iFor j = 0 To tLend(0, j) = jNext jFor i = 1 To sLenFor j = 1 To tLenIf mid(s, i, 1) = mid(t, j, 1) Thencost = 0Elsecost = 1End Ifd(i, j) = GetMinValue(GetMinValue(d(i - 1, j) + 1, d(i, j - 1) + 1), d(i - 1, j - 1) + cost)Next jNext iLevenshteinDistance = d(sLen, tLen)
End Function
Function GetMinValue(ByVal Num1, ByVal Num2)Dim MinValue As DoubleMinValue = Num1If Num2 < MinValue Then MinValue = Num2GetMinValue = MinValue
End Function
Function similarity1(s As String, t As String) As DoubleDim maxLen As IntegerDim dist As IntegerIf Len(s) > Len(t) ThenmaxLen = Len(s)ElsemaxLen = Len(t)End IfIf maxLen = 0 Thensimilarity1 = 1# ' 如果两个字符串都为空，视为完全相似Exit FunctionEnd Ifdist = LevenshteinDistance(s, t)similarity1 = 1# - (dist / maxLen)
End FunctionSub TestSimilarity()Dim str1 As StringDim str2 As StringDim similarity As Doublestr1 = ActiveDocument.Content.Paragraphs(1).Range.textstr2 = ActiveDocument.Content.Paragraphs(3).Range.textstr1 = Replace(str1, vbCr, "")str2 = Replace(str2, vbCr, "")similarity = similarity1(str1, str2)MsgBox "文本相似度: " & Format(similarity, "0.00%")
End Sub
