在Word中,用VBA比较两段文本的相似度

效果1:

去掉字符串中回车,进行改进后效果:

代码:

vbscript 复制代码
Function LevenshteinDistance(s As String, t As String) As Integer
    Dim d() As Integer
    Dim i As Integer
    Dim j As Integer
    Dim cost As Integer

    Dim sLen As Integer
    Dim tLen As Integer

    sLen = Len(s)
    tLen = Len(t)

    ReDim d(sLen, tLen)

    For i = 0 To sLen
        d(i, 0) = i
    Next i

    For j = 0 To tLen
        d(0, j) = j
    Next j

    For i = 1 To sLen
        For j = 1 To tLen
            If mid(s, i, 1) = mid(t, j, 1) Then
                cost = 0
            Else
                cost = 1
            End If

            d(i, j) = GetMinValue(GetMinValue(d(i - 1, j) + 1, d(i, j - 1) + 1), d(i - 1, j - 1) + cost)
        Next j
    Next i

    LevenshteinDistance = d(sLen, tLen)
End Function
Function GetMinValue(ByVal Num1, ByVal Num2)
    Dim MinValue As Double
    MinValue = Num1
    If Num2 < MinValue Then MinValue = Num2
    GetMinValue = MinValue
End Function
Function similarity1(s As String, t As String) As Double
    Dim maxLen As Integer
    Dim dist As Integer
    If Len(s) > Len(t) Then
        maxLen = Len(s)
        
    Else
        maxLen = Len(t)
    End If
    If maxLen = 0 Then
        similarity1 = 1#  ' 如果两个字符串都为空,视为完全相似
        Exit Function
    End If

    dist = LevenshteinDistance(s, t)
    similarity1 = 1# - (dist / maxLen)
End Function

Sub TestSimilarity()
    Dim str1 As String
    Dim str2 As String
    Dim similarity As Double

    str1 = ActiveDocument.Content.Paragraphs(1).Range.text
    str2 = ActiveDocument.Content.Paragraphs(3).Range.text
    str1 = Replace(str1, vbCr, "")
    str2 = Replace(str2, vbCr, "")
    
    similarity = similarity1(str1, str2)
    MsgBox "文本相似度: " & Format(similarity, "0.00%")
End Sub
相关推荐
gc_22996 小时前
C#测试调用OpenXml操作word文档的基本用法
c#·word·openxml
vfvfb12 小时前
word文档结尾批量插入图片 docx批量插入图片 指定几张
word·docx插入图片·word批量插入图片·word文档批量插入图片
老马啸西风1 天前
sensitive-word 敏感词性能提升14倍优化全过程 v0.28.0
安全·开源·nlp·word·敏感词·sensitive-word
象骑士Hack2 天前
Word 常用快捷键大全:提升文档处理效率的必备技巧
word
会飞的小菠菜2 天前
如何根据Excel数据表生成多个合同、工作证、录取通知书等word文件?
word·excel·模板·数据表·生成文件
IT小农工2 天前
Windows 文件资源管理器无法预览文件内容word、ppt、excel、pdf
windows·word·powerpoint
BillKu2 天前
在 Delphi 5 中获取 Word 文档页数的方法
word·delphi
IssacNew2 天前
【原创软件】第14期:FastWordReplace-Word文字批量替换工具V1.1
word·文字替换·批量替换
XiaoMu_0012 天前
【Markdown转Word完整教程】从原理到实现
word·markdown
zlpzlpzyd3 天前
jodconverter将word转pdf底层libreoffice的问题
pdf·word