在实践中经常会遇到比较相似字符串的任务：我最近在尝试将电子邮件地址从一个程序导入另一个程序时遇到了它。
例如，一个地址可能看起来像“特维尔州，Kashin g，Sovetskaya ul，1、5”，而另一个地址则看起来像“特维尔州； 喀欣市； Sovetskaya街； 房子1; 5号公寓。 这些线相似吗？ 当然可以。 并通过“裸眼”可以看到它们的结构：区域-定居点-街道-房屋-公寓。 对于地址而言，将行分解成组很重要，这是合乎逻辑的； 也就是说，我们不应该将相似单词的``两种谷物''（其中一个``粥''由第一行的单词组成，第二行的第二个单词组成）进行比较，而应该对第一行中的单词与第二行中的单词进行``分组''比较。 还检查了分组的标准：在第一行中，组的分隔符为“，”，在第二行中为“;”； ”。
同时，在某些行中看不到显式分组。 例如，以“经典”为例：“如果同志们没有达成一致，他们的工作将不会顺利进行，也不会奏效，只是面粉。” 第二行：“胡闹的猴子，驴，山羊和马蹄泰迪熊开始演奏四重奏。” 显然，两者的界限是不同的（尽管这些寓言的相似之处，甚至寓言的寓意也不同）。
有问题的任务不是新任务。 有一些算法（有时非常复杂）试图解决它，有时甚至成功解决了它。 我提出了另一个算法框。 编译时，我遵循以下原则：
此外，该算法是在VBA Excel上实现的，因此非常“民主”，可在任何地方使用：Excel不仅“独立”存在于各种计算机的软件中，而且还将来自各种DBMS和应用程序的数据导出到其中。
因此，让我们开始吧。
比较功能称为StrCompare。 它具有4个参数，其中两个是可选的：第一行str1，第二行str2，第一行div1的组分隔符和第二行div2的组分隔符。 如果省略div1或div2，则默认分隔符为“ |”。 “ |” 选择它是因为它不太可能出现在“平均”行中，因此可以用来比较整体（不可分组）行。 这样的整体弦也可以认为是由一组构成的弦。 也就是说，比较函数的标题如下所示：
Public Function StrCompare(str1 As String, str2 As String, Optional div1 As String = "|", Optional div2 As String = "|") As Single
单-因为函数的结果将是一个数字，显示比较的字符串的相似程度。
将第1行的所有组依次与第2行的所有组逐个单词进行比较，并考虑每对组中的单词匹配数。 对于第1行的每个组，最后选择第2行中的“最佳组”（即，匹配度最高的组）。 检查每对单词的匹配项是否具有最小长度的单词：即“ street = street”和“ g = city”。 此规则不适用于数字：即200 <> 20。 选择单词时，组中的所有“无关紧要的字符”都只是单词分隔符，但它们本身将被忽略，即，单词只能由字符组成WordSymbols =“ 0123456789ABBGDEJEZLKLMNOPRSTUFKHCHSHYYEYEYABCDEFGHIJKLMNOPYRXUVXWVX。 可以理解，不考虑大小写。
为了在第二行的当前组中搜索匹配的单词，使用了快速半分法（但与“经典”方法相比略有现代化，因为使用上述方法检查了匹配）。 并且由于半除法的操作需要排序数组，因此还使用了快速排序算法。
StrCompare函数的结果将是匹配的单词数除以第1行和第2行中单词总数的结果：
StrCompare = (da * 2) / ((kon1_2 - nach1_2 + 1) * (kon1_1 - nach1_1 + 1) + (kon2_2 - nach2_2 + 1) * (kon2_1 - nach2_1 + 1))
在此，例如，kon1_2是数组维度1（包含在第一行的组中的单词数组）在第二维（第一个维度是组的数量，第二个是组中的单词的数量）的最终边界。
现在该介绍代码了：
' "" . : '1, 2, 1, 2 Public Function StrCompare(str1 As String, str2 As String, Optional div1 As String = "|", Optional div2 As String = "|") As Single WordSymbols = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" Dim massiv1() As String, massiv2() As String, mass1() As String, mass2() As String, m1() As Variant, m2() As Variant ' Dim mm1() As String, mm2() As String Dim nach1_1 As Integer, kon1_1 As Integer, nach1_2 As Integer, kon1_2 As Integer, nach2_1 As Integer, kon2_1 As Integer, nach2_2 As Integer, kon2_2 As Integer Dim item As String, itemnumber As Integer Dim yes As Integer, maxyes As Integer, da As Integer Dim counter As Integer ' noname str1 = UCase(str1): str2 = UCase(str2) massiv1 = Split(str1, div1) ReDim mass1(LBound(massiv1) To UBound(massiv1), 0 To 1000) maxk = 0 counter = 0 For i = LBound(massiv1) To UBound(massiv1) item = massiv1(i) dlina = Len(item) slovo = "" NewWord = False k = 0 ' For j = 1 To dlina bukva = mid(item, j, 1) If (InStr(1, WordSymbols, bukva) > 0) And Not NewWord Then NewWord = True slovo = slovo + bukva Else If InStr(1, WordSymbols, bukva) > 0 Then slovo = slovo + bukva Else If (InStr(1, WordSymbols, bukva) = 0) And NewWord Then NewWord = False mass1(i, k) = slovo If k > maxk Then maxk = k k = k + 1 slovo = "" End If End If End If Next j If NewWord Then mass1(i, k) = slovo If k > maxk Then maxk = k End If Next i ReDim Preserve mass1(LBound(massiv1) To UBound(massiv1), 0 To maxk) '*************************************************************' massiv2 = Split(str2, div2) ReDim mass2(LBound(massiv2) To UBound(massiv2), 0 To 1000) maxk = 0 For i = LBound(massiv2) To UBound(massiv2) item = massiv2(i) dlina = Len(item) slovo = "" NewWord = False k = 0 ' For j = 1 To dlina bukva = mid(item, j, 1) If (InStr(1, WordSymbols, bukva) > 0) And Not NewWord Then NewWord = True slovo = slovo + bukva Else If InStr(1, WordSymbols, bukva) > 0 Then slovo = slovo + bukva Else If (InStr(1, WordSymbols, bukva) = 0) And NewWord Then NewWord = False mass2(i, k) = slovo If k > maxk Then maxk = k k = k + 1 slovo = "" End If End If End If Next j If NewWord Then mass2(i, k) = slovo If k > maxk Then maxk = k End If Next i ReDim Preserve mass2(LBound(massiv2) To UBound(massiv2), 0 To maxk) ' "" ; : kon1_2 - 1 2- nach1_1 = LBound(mass1, 1) kon1_1 = UBound(mass1, 1) nach1_2 = LBound(mass1, 2) kon1_2 = UBound(mass1, 2) nach2_1 = LBound(mass2, 1) kon2_1 = UBound(mass2, 1) nach2_2 = LBound(mass2, 2) kon2_2 = UBound(mass2, 2) For i = nach1_1 To kon1_1 For j = nach1_2 To kon1_2 If mass1(i, j) = "" Then counter = counter + 1 mass1(i, j) = "noname" + Trim(Str(counter)) End If 'MsgBox ("mass1(" + Trim(Str(i)) + "," + Trim(Str(j)) + ")=" + mass1(i, j)) Next j Next i For i = nach2_1 To kon2_1 For j = nach2_2 To kon2_2 If mass2(i, j) = "" Then counter = counter + 1 mass2(i, j) = "noname" + Trim(Str(counter)) End If 'MsgBox ("mass2(" + Trim(Str(i)) + "," + Trim(Str(j)) + ")=" + mass2(i, j)) Next j Next i ' " -" ReDim m2(nach2_2 To kon2_2) As Variant For i = nach2_1 To kon2_1 For j = nach2_2 To kon2_2 m2(j) = mass2(i, j) Next j Call QuickSort(m2, nach2_2, kon2_2) For j = nach2_2 To kon2_2 mass2(i, j) = m2(j) Next j Next i ' : 1 2 ReDim mm2(nach2_2 To kon2_2) da = 0 For k = nach1_1 To kon1_1 ' 1 maxyes = 0 For i = nach2_1 To kon2_1 ' 2 yes = 0 For j = nach2_2 To kon2_2: mm2(j) = mass2(i, j): Next j ' 2 For l = nach1_2 To kon1_2 ' 1 If BinarySearch(mm2, nach2_2, kon2_2, mass1(k, l)) <> -1 Then yes = yes + 1 Next l If yes > maxyes Then maxyes = yes Next i da = da + maxyes Next k StrChange = (da * 2) / ((kon1_2 - nach1_2 + 1) * (kon1_1 - nach1_1 + 1) + (kon2_2 - nach2_2 + 1) * (kon2_1 - nach2_1 + 1)) 'StrChange = da End Function Public Sub QuickSort(ByRef vArray() As Variant, inLow As Integer, inHi As Integer) Dim pivot As Variant Dim tmpSwap As Variant Dim tmpLow As Integer Dim tmpHi As Integer tmpLow = inLow tmpHi = inHi pivot = vArray((inLow + inHi) \ 2) While (tmpLow <= tmpHi) While (vArray(tmpLow) < pivot And tmpLow < inHi) tmpLow = tmpLow + 1 Wend While (pivot < vArray(tmpHi) And tmpHi > inLow) tmpHi = tmpHi - 1 Wend If (tmpLow <= tmpHi) Then tmpSwap = vArray(tmpLow) vArray(tmpLow) = vArray(tmpHi) vArray(tmpHi) = tmpSwap tmpLow = tmpLow + 1 tmpHi = tmpHi - 1 End If Wend If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi End Sub Public Function BinarySearch(vArray() As String, inLow As Integer, inHi As Integer, key As String) As Integer Dim lev As Integer, prav As Integer, mid As Integer Dim key_ As String, arritem As String, arritem_ As String Dim minlen As Integer, keylen As Integer, arritemlen As Integer If key = Trim(Str(Val(key))) Then ' lev = inLow: prav = inHi While lev <= prav mid = lev + (prav - lev) \ 2 arritem = vArray(mid) If key < arritem Then prav = mid - 1 ElseIf key > arritem Then lev = mid + 1 Else BinarySearch = mid Exit Function End If Wend Else keylen = Len(key) lev = inLow prav = inHi While lev <= prav mid = lev + (prav - lev) \ 2 arritem = vArray(mid) arritemlen = Len(arritem) minlen = IIf(keylen < arritemlen, keylen, arritemlen) key_ = left(key, minlen) arritem_ = left(arritem, minlen) If key_ < arritem_ Then prav = mid - 1 ElseIf key_ > arritem_ Then lev = mid + 1 Else BinarySearch = mid Exit Function End If Wend End If BinarySearch = -1 End Function
我认为注释所有内容都是没有意义的：您可以通过代码进行导航。 只需在不同性质的几条线上分析比较功能的操作即可。
- str1 =“特维尔地区。，Kashin g，Sovetskaya street，1，5” str2 =”特维尔地区； 喀欣市； Sovetskaya街； 房子1; 5号公寓。
首先，比较排除组的行：
StrCompare（str1，str2）得出的结果为0.8888889。
现在考虑：
StrCompare（str1，str2，“，”，“;”）-结果为0.8。
如您所见，组与比较之间的关系更加严格； 在这种情况下，对他们来说重要的是“房子就是房子，公寓就是公寓”。 当忽略组时，这不起作用。 - str1 =“我的祖母住灰山羊” str2 =“祖母住灰山羊”
StrCompare（str1，str2）-> 0.6666667 - str1 =” Ivanov Ivan Ivanovich m。 卡卢加州（Kaluga）1950年“ str2 =”伊万诺夫（Ivanov I.I.） 01/20/1950”
StrCompare（str1，str2）-> 0.6153846 - str1 =“如果同志们没有达成一致，他们的工作将无法顺利进行，也不会成功，只能是面粉。” str2 =“胡闹的猴子，驴，山羊和马蹄泰迪熊开始演奏四重奏。”
StrCompare（str1，str2）-> 0 - str1 =”根据第1条的规定 如果根据电力供应协议的订户是使用能源进行家庭消费的公民，则按照俄罗斯联邦民法540的规定，从订户实际连接到网络的那一刻起，合同即被视为已订立。 |根据俄罗斯联邦《住房法》第153条第1款，公民有义务及时和全额支付住房和公用事业费用。 | 从“ ____” __________ 2017年到“ ____” __________ 2017年期间，担保供应商向您提供了______________________的电量。 |关于您违反电力付款义务的行为，这导致在两个以上的结算期内形成了对担保供应商的消费者债务，我们采取措施限制消费者的住房，但损害了担保的供应商/ |恢复为电力供应提供公用事业服务|根据《向多公寓建筑物的房主和用户提供公用事业服务规则》第121条第（1）款 x和住宅楼，由政府法令06.05.2011g批准。 在第354号法律中，承包商对限制，暂停和恢复向债务人债务提供公用事业服务的支出应由承担上述费用的消费者承担。供应商的金额______________________________________________。|根据前述，FE TverAtomEnergoSbyt要求您偿还债务以采取行动 市政服务限制/更新电力在_____________________卢布的金额。 关于以下详细信息以及个人帐号和付款目的：”
担保人JSC AtomEnergoSbyt与_____________________之间的str2 =“ 2017年____________________消费者签订了___________________________的能源供应协议，有效期为_______年，其条件得到进一步延长（协议第8.1条，俄罗斯联邦民法第540条） ），按照第1.1条的规定。 担保供应商承诺出售电能（电力），并独立或通过第三方提供电力传输服务和服务，提供这些服务和服务是向消费者提供电能的过程中不可或缺的一部分，买方承诺支付所购买的电能（电力） 。 |与消费者违反其支付电能的义务有关（第__________________号供电协议第5.2条），从而导致消费者向担保供应商欠下的债务超过了与消费者的电网设施有关的一个计费期-_______________按照完全和（或）部分限制用电制度的规则，采取了行动来限制/恢复能耗制度， 由俄罗斯联邦政府于2012年4月5日第442号法令批准（以下简称“规则”）。 |根据《规则》第24段，消费者有义务向承包商赔偿采取限制措施并随后恢复电能消耗制度的费用|担保供应商支付的采取限制措施并随后恢复电能消耗制度的费用为__________________。以上所述，操作“ TverAtomEnergoSbyt”要求您为以下行为支付保证供应商的费用： 瓦特/恢复模式的电力消耗在_______________卢布的量。 有关合同编号和付款目的的以下详细信息：|付款目的：根据合同号____________支付限制/恢复电能消耗制度的信息”
这里的str1和str2是非常相似的文档的片段（分别用于个人和法人的能源供应协议）。 对于文档相似性的“粗略评估”，可以使用不带StrCompare组（str1，str2，“ *”，“ *”）的比较（在这种情况下，“ |”字符不合适，因为在原始行中使用了|来打断它们）组），显示出0.75的体面相似度（即文档显然具有相同的性质！）。 为了具体化相似性，我们使用分组：StrCompare（str1，str2，“ |”，“ |”）（或仅使用StrCompare（str1，str2））。 结果：0.3790227。
而现在，也许是最有趣的例子。 自伊索时代以来，关于乌鸦和狐狸的寓言情节就广为人知。 使用StrCompare，比较两个寓言：I.A.的经典版本。 克雷洛娃（Krylova），鲜为人知。 Sumarokova：
str1 =”他们向世界重复了几次，这种奉承是卑鄙的，有害的； 但不是为了未来，而发自内心的奉承者总是会找到一个角落。 上帝向沃罗尼某处送了一块奶酪； 早餐堆在云杉乌鸦上，已经准备好了，是的，考虑周到，我把奶酪放在嘴里。 不幸的是，福克斯跑得很近。 突然，丽莎的俗气停止了：狐狸看到了奶酪，狐狸捕获了奶酪。 树上的脚尖在tip脚。 他扭曲了尾巴，没有将视线从乌鸦上移开，说话的声音如此甜美，微微呼吸：“亲爱的，多么好！ 真是脖子，真是眼睛！ 说对了，童话吧！ 什么梨！ 真是袜子！ 而且，确实，天使必须有声音！ 唱歌，轻声，不要as愧！ 姐姐，如果这样的美丽，你是个会唱歌的手工艺者，-毕竟，如果我们有一只国王鸟！” Veschunya的头在赞美中旋转着，高兴地垂下了呼吸-对友善的Lisitsyna来说，乌鸦的话淹没了她的整个喉咙：奶酪掉了-他的作弊就是这样。
str2 =”鸟儿紧紧抓住人类的手艺。 一只乌鸦曾经把奶酪带到表哥那里，坐在橡树上。 是的，只是没吃过一点。 狐狸在嘴里看到一块，她想：“我给乌鸦汁！ 尽管我不会到那儿，但无论多高，我都会得到这件橡木。” 福克斯说：“太好了，朋友，漏斗，叫姐姐！” 你是只美丽的鸟！ 什么样的剪刀，什么样的袜子，你可以毫不虚伪地告诉你，你比什么都重要，我的小灯，很好！ 鹦鹉，灵魂无处不在，你的孔雀羽毛更美丽一百倍！” （愉快的赞美不是很讨人喜欢的）。 “哦，如果您仍然会唱歌，那么世界上就不会有这种鸟了！” 乌鸦张开脖子，变成了夜莺，“他想起了奶酪，然后我就可以吃了。” 这分钟我不是在谈论一场盛宴！” 我张开嘴，等待着禁食。 他只看到Lisitsyn尾巴的末端。 我想唱歌，我不唱歌，我想吃，我没吃。
原因是奶酪不再存在。 奶酪掉了下来，福克斯吃了午饭。
StrCompare（str1，str2）得出的结果为0.5590062-因此存在绘图相似性！