Function CompStr(Str1 As String, Str2 As String, Optional KillCyr As Boolean = False) As Single

Dim Word As Integer, likeness As Long, i As Integer
Dim maxn As Integer, k As Integer
Dim s1 As String, s2 As String
Word = 3: likeness = 0
s1 = Trim(CutDblSpaces(IIf(Len(Str1) > Len(Str2), Str1, Str2)))
s2 = Trim(CutDblSpaces(IIf(Len(Str1) > Len(Str2), Str2, Str1)))
If KillCyr Then
  s1 = KillCyrillic(s1)
  s2 = KillCyrillic(s2)
End If
If Len(s1) < Word + 1 Or Len(s2) < Word + 1 Then
  CompStr = IIf(s1 = s2, 1, 0)
  Exit Function
End If

For i = 1 To Len(s1) - Word + 1
  maxn = 0
  k = InStr(1, s2, Mid$(s1, i, Word))
  Do Until k = 0
    If Len(s1) - Abs(k - i) > maxn Then maxn = Len(s1) - Abs(k - i)
    k = InStr(k + 1, s2, Mid$(s1, i, Word))
  Loop
  likeness = likeness + maxn
Next
CompStr = likeness / (Len(s1) * (Len(s1) - Word + 1))
  
End Function