VBA在字符串内查找80%相似英文单词

长春鱼鱼

香川群子 发表于 2015-10-27 12:10
可以用VBA比对两个单词中，完全相同的部分的最大长度。
达到一定标准就列为相似。

恩。差异个数小于3，可能比较容易实现些吧？

长春鱼鱼

香川群子 发表于 2015-10-27 12:23
高频词中有疑问：

Spring/Autumn 应该分开来处理。否则无意义。

这个我刚刚看错了。高频词Spring/Autumn，是应该分开处理。我提供的原数据错了，请变成2个单词：Spring和Autumn。代码不用考虑这点。

多谢！

香川群子

呵呵，附件刚才没上吗？

重新上附件。

就按你说的，简单一点：
排除高频词表，以及第2、3、4列中所有相同的单词，忽视所有含数字的单词。

……
本来用字典或许能更快一些。但是懒得改了。你先用着。

香川群子

改用字典的代码附件：

1. Sub test()
   
2.    
   
3.     ar = Sheet2.[a1].Resize(Sheet2.[a1].End(4).Row) '读取Sheet2中A列高频词 无需排序
   
4.     Set d = CreateObject("Scripting.Dictionary") '设置字典
   
5.     For i = 2 To UBound(ar)
   
6.         d(ar(i, 1)) = "" '高频词读入字典
   
7.     Next
   
8.    
   
9.     ar = [a1].CurrentRegion.Offset(1) '重新读取表1待处理数据
   
10.     For i = 1 To UBound(ar) - 1
    
11.         s = Split(ar(i, 1)): tmp = "" '按空格划分单词
    
12.         For j = 0 To UBound(s)
    
13.             t = s(j): If Len(t) Then If Not t Like "*[0-9]*" Then If Not d.Exists(t) Then tmp = tmp & " " & t
    
14.             '检查每个单词 如果不为空、不含数字，则输出字典中不含有的单词 字典中有相同的就去除。
    
15.         Next
    
16.         
    
17.         t2 = ar(i, 2) & "" & ar(i, 3) & "" & ar(i, 4) '合并第2、3、4列单词
    
18.         s = Split(tmp): tmp = ""
    
19.         For j = 0 To UBound(s) '剩余单词继续检查 如果不相同就保留，相同就去除
    
20.             t = s(j): If InStr(t2, t) = 0 Then tmp = tmp & " " & t
    
21.         Next
    
22.         ar(i, 1) = tmp '整理后结果存入数组
    
23.     Next
    
24.     [e2].Resize(UBound(ar)) = ar '输出结果到E列
    
25.     MsgBox "OK"
    
26. End Sub
    

复制代码

香川群子

如果按最初提出的想法要排除相似单词，则需另外写一个判断2个单词之间相似度的函数。

这个是可以的。

香川群子

判断2个单词相似度的VBA自定义函数如下：

1. Function f(s1, s2)
   
2.     If Len(s1) < Len(s2) Then t1 = s1: t2 = s2 Else t1 = s2: t2 = s1
   
3.     For i = 1 To Len(t1)
   
4.         For j = Len(t1) - i + 1 To 1 Step -1
   
5.             If InStr(t2, Mid(t1, i, j)) Then f = j / Len(t1): Exit Function
   
6.         Next
   
7.     Next
   
8. End Function

复制代码

以字数最少的单词的字数L为基准，计算单词s1和s2中相同部分t的字符长度j的百分比。

如：
abcd / abc ……相似度100%
start / tarts …… 相似度80%

但是，具体这个相似度计算结果该怎么用，还需楼主思考。

香川群子

相似度函数改进一下：

第3参数默认k=0时不区分大小写，而k=1时区分大小写。
第3参数意义： 按字数最低n个起比较是否相同。默认n=1为1个字符起。

1. Function sim#(s1$, s2$, Optional k = 0, Optional n = 1)
   
2.     If k = 0 Then s1 = UCase(s1): s2 = UCase(s2)
   
3.     If Len(s1) < Len(s2) Then t1 = s1: t2 = s2 Else t1 = s2: t2 = s1
   
4.     For i = 1 To Len(t1)
   
5.         For j = Len(t1) - i + 1 To n Step -1
   
6.             If InStr(t2, Mid(t1, i, j)) Then sim = j / Len(t1): Exit Function
   
7.         Next
   
8.     Next
   
9. End Function

复制代码

袁振涛

下午我也写了下，先把含数字的去掉
然后再把类似top tops  topss这样结尾不同的去掉
基本就剩不了多少单词了
中间有字符有差异的，可以考虑判断两个单词只有一个字母不同，并且是相同的位置不同，那样也就容易了

长春鱼鱼

袁振涛 发表于 2015-10-27 18:26
下午我也写了下，先把含数字的去掉
然后再把类似top tops  topss这样结尾不同的去掉
基本就剩不了多少单 ...

恩。可以把代码贴下不？

运行正常的话，最后确实没有多少单词剩余，大概3-4个吧。

多谢！

袁振涛

代码在单位写了点，没写完。思路如下，有无聊的可以按这思路完成下，我估计这样就差不多了
先关键字全部进字典
1、(?=.*?\d)\b(\w|-)+\b  判断数字或含数字的字符  F4279 S-5Xl st2445 2014    用replace全部清除含数字的单词
2、((\w|-){3,})(\w{1,2})?  判断单词后面多一到两个字母的情况 ，例如  top与其本身以及tops、topss的匹配
3、(\w+)(\w)(\w+) \1((?!\2)\w)\3  判断两个单词只有同样位置的一个字母不同 例如women,woman   
这三步做完估计就剩不下几个了