ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1054|回复: 0

求助,如何批量处理?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2015-4-5 13:22 | 显示全部楼层 |阅读模式
各位专家:
      小虫在网上找到一段可以计算两个单元格文字间Levenshtein edit distance距离的vba代码,但是该代码只能一次处理两个单元格,我如果想批量处理两列文本的相似度,不知道该如何修改该代码?
      谢谢!

Public result As Double

Public Function Levenshtein_Distance(ByVal str1 As String, ByVal str2 As String) As Double
    Dim d As Long
    If Len(str1) > Len(str2) Then
        d = Len(str1)
    Else
        d = Len(str2)
    End If
    result = 1 - (LD(str1, str2) / d)
End Function

Private Function Minimum(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
    Minimum = min
End Function

Public Function LD(ByVal s As String, ByVal t As String) As Integer
    Dim dis() As Integer
    Dim m As Integer
    Dim n As Integer
    Dim i As Integer
    Dim j As Integer
    Dim s_i As String
    Dim t_j As String
    Dim cost As Integer
    n = Len(s)
    m = Len(t)
    If n = 0 Then
        LD = m
        Exit Function
    End If
    If m = 0 Then
        LD = n
        Exit Function
    End If
    ReDim dis(0 To n, 0 To m)
    For i = 0 To n
        dis(i, 0) = i
    Next i
    For j = 0 To m
        dis(0, j) = j
    Next j
    For i = 1 To n
        s_i = Mid$(s, i, 1)
        For j = 1 To m
            t_j = Mid$(t, j, 1)
            If s_i = t_j Then
                cost = 0
            Else
                cost = 1
            End If
            dis(i, j) = Minimum(dis(i - 1, j) + 1, dis(i, j - 1) + 1, dis(i - 1, j - 1) + cost)
        Next j
    Next i
    LD = dis(n, m)
    Erase dis
End Function

Sub cc()
    str1 = Sheets("sheet1").Range("A1").Value
    str2 = Sheets("sheet1").Range("B1").Value
    Levenshtein_Distance str1, str2
    MsgBox result
    [C1] = result
End Sub


您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-26 00:29 , Processed in 0.022544 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表