字符串的相似度计算

Chtwo

工作需要，会涉及到整理大量的数据，遇到比较头疼的问题之一就是字符串类似。 比如客户   XXXX有限公司，XXXX公司，XXXX有限责任公司等等，其实是一个客户，但长期以来基础数据维护不好导致分散成了多个。比较难清理。

所以写了一个宏辅助，计算两个字符串的相似度来辅助查找可能重复的数据。好过一个个查询。如果大家有其他好办法请介绍介绍，呵呵。


算法：是用两个字符串滑动比较时匹配的字符数，和两字符串滑动比较的重叠率，定义了相似度。就是在两个字符串想比较时，将短的字符串拆开移动并增加空格，使它长度与长字符串一致，并最大程度使其他字符与长字符串中的字符匹配。根据插入的空格和匹配率在确定相似度。   这个算法还是蛮可靠的。大家可以在网上找到类似的算法说明。

宏写的比较烂，密码是welcome! 请大家指正。

能实现我需要的功能，开心，发帖。。{:soso_e113:}

用法：需要建“比较源”和“相似度”SHEET页，这些就没有仔细处理了，需要手工建一下。需要比较的数据放在比较源B列，运行宏即可。其他参数大家可以看看说明。

{:soso_e113:}

shaokui123

支持支持，我顶一个，用到了，谢谢高手了

shaokui123

大侠，能不能再增加个功能，就是不同的地方加粗加大字号变色突出显示呢

Chtwo

呵呵，抱歉啊，这个搞不定。

SnowSie

1. Option Explicit
   
2. Sub TEST()
   
3.     Dim i%, arr, brr(), n, k, d As Object, crr
   
4.     arr = [a1].CurrentRegion
   
5.     crr = [a1].CurrentRegion
   
6.     Application.ScreenUpdating = False
   
7.     For i = 1 To UBound(arr)
   
8.         n = InStr(arr(i, 2), "公司")
   
9.         If n > 0 Then
   
10.             arr(i, 2) = Left(arr(i, 2), n - 1) & Right(arr(i, 2), Len(arr(i, 2)) - n - 1)
    
11.         End If
    
12.         n = InStr(arr(i, 2), "有限")
    
13.         If n > 0 Then
    
14.             arr(i, 2) = Left(arr(i, 2), n - 1) & Right(arr(i, 2), Len(arr(i, 2)) - n - 1)
    
15.         End If
    
16.         n = InStr(arr(i, 2), "责任")
    
17.         If n > 0 Then
    
18.             arr(i, 2) = Left(arr(i, 2), n - 1) & Right(arr(i, 2), Len(arr(i, 2)) - n - 1)
    
19.         End If
    
20.     Next
    
21.     [a1].CurrentRegion = arr
    
22.     n = 0
    
23.     Set d = CreateObject("Scripting.Dictionary")
    
24.     arr = [a1].CurrentRegion
    
25.     For i = 1 To UBound(arr)
    
26.         If Not d.exists(arr(i, 2)) Then
    
27.             d(arr(i, 2)) = ""
    
28.             n = n + 1
    
29.             ReDim Preserve brr(1 To 5, 1 To n)
    
30.             brr(1, n) = n: brr(2, n) = arr(i, 2) & "有限责任公司": brr(3, n) = arr(i, 3): brr(4, n) = arr(i, 4): brr(5, n) = arr(i, 5)
    
31.         End If
    
32.     Next
    
33.     [a10].Resize(n, 5) = Application.Transpose(brr)
    
34.     [a1].CurrentRegion = crr
    
35.     Application.ScreenUpdating = True
    
36. End Sub

复制代码

曾几何时也遇到此问题，数据量很大，名称五花八门，当时是这样解决的，把可能重复的值都列出来。然后只把关键字取出，然后进行判断，当然可能列不尽  所以正确率大概也只有80%左右，根据你的附近就是这样的。。

Chtwo

oracle数据库中有内置的函数，UTL_MATCH.EDIT_DISTANCE_SIMILARIT ， 后来转到oracle库中处理。也很方便。脚本就不放上来了。

zouhy0442

Chtwo 发表于 2014-3-12 11:13
oracle数据库中有内置的函数，UTL_MATCH.EDIT_DISTANCE_SIMILARIT ， 后来转到oracle库中处理。也很方便。脚 ...

Oracle中的这个就是Levenshtein算法，对中文好像不是很好。

笨鸟使劲飞

下载下来不会用啊，能不能说详细一些呢？

香川群子

是否应该这样子：

比较字符串Str1 按每2个字符一组拆分，存入字典。

遍历其余待检查字符串，同样每2个字符一组拆分，和字典进行比较。
如果相同则统计+1

同时，加入考虑位置、顺序的评估函数，最后得到相似度。呵呵。

ili

这种问题，我想再怎么好的算法都不能百分百准确，要考虑清楚自己情况是否能允许出错。