Нечеткое сравнение строк
Аргументы: lngMaxLen - максимальная длина сравниваемых подстрок (читайте описание алгоритма сравнения строк), strStringMatching- первая строка, strStringStandart - вторая строка, lngCase - тип сравнения (с учётом регистра или без учёта)
Назначение: Нечеткое сравнение двух строк
Возвращает: Возвращает коэффициент совпадения строк от 0 до 100 ( 0 - строки не совпадают, 100 - полное совпадение).
Public Type RetCount
lngSubRows As Long
lngCountLike As Long
End Type
Public Function IndistinctMatching(lngMaxLen As Long, strStringMatching As String, strStringStandart As String, lngCase As Long) As Long
Dim gret As RetCount
Dim tret As RetCount
Dim lngCurLen As Long
If lngMaxLen = 0 Or Len(strStringMatching) = 0 Or Len(strStringStandart) = 0 Then
IndistinctMatching = 0
Exit Function
End If
gret.lngCountLike = 0
gret.lngSubRows = 0
For lngCurLen = 1 To lngMaxLen
tret = MatchingStrings(strStringMatching, strStringStandart, lngCurLen, lngCase)
gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
tret = MatchingStrings(strStringStandart, strStringMatching, lngCurLen, lngCase)
gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
Next lngCurLen
If gret.lngSubRows = 0 Then
IndistinctMatching = 0
Exit Function
End If
IndistinctMatching = (gret.lngCountLike / gret.lngSubRows) * 100
End Function
Public Function MatchingStrings(strA As String, strB As String, lngLen As Long, lngCase As Long) As RetCount
Dim tret As RetCount
Dim y As Long, z As Long
Dim strta As String
Dim strtb As String
For z = 1 To Len(strA) - lngLen + 1
strta = Mid(strA, z, lngLen)
y = 1
For y = 1 To Len(strB) - lngLen + 1
strtb = Mid(strB, y, lngLen)
If StrComp(strta, strtb, lngCase) = 0 Then
tret.lngCountLike = tret.lngCountLike + 1
Exit For
End If
Next y
tret.lngSubRows = tret.lngSubRows + 1
Next z
MatchingStrings.lngCountLike = tret.lngCountLike
MatchingStrings.lngSubRows = tret.lngSubRows
End Function
Алгоритм сравнения строк
Функция нечёткого сравнения использует в качестве аргументов две строки и параметр сравнения - максимальную длину сравниваемых подстрок. Результатом работы функции является число, лежащее в пределах от 0 до 1. 0 соответствует полному несовпадению двух строк, а 1 - полной (в определённом ниже смысле) их идентичности.
Сравнение строк происходит по следующей схеме. Пусть, например, в качестве аргументов заданы две строки "test" и "text" и некоторая максимальная длина подстрок, скажем, 4. Функция сравнения составляет все возможные комбинации подстрок с длинной вплоть до указанной и подсчитывает их совпадения в двух сравниваемых строках. Количество совпадений, разделённое на число вариантов, объявляется коэффициентом схожести строк и выдаётся в качестве результата работы функции.
Продолжим пример.
Сравниваемая подстрока
Подстроки второй строки
Есть совпадение?
Количество совпадений
Количество вариантов
Сравниваем строку test со строкой text по подстрокам длины 1.
t
t, e, x, t
да
3
4
e
t, e, x, t
да
s
t, e, x, t
нет
t
t, e, x, t
да
Сравниваем строку text со строкой test по подстрокам длины 1.
t
t, e, s, t
да
3
4
e
t, e, s, t
да
x
t, e, s, t
нет
t
t, e, s, t
да
Сравниваем строку test со строкой text по подстрокам длины 2.
te
te, ex, xt
да
1
3
es
te, ex, xt
нет
st
te, ex, xt
нет
Сравниваем строку text со строкой test по подстрокам длины 2.
te
te, es, st
да
1
3
ex
te, es, st
нет
xt
te, es, st
нет
Сравниваем строку test со строкой text по подстрокам длины 3.
tes
tex, ext
нет
0
2
est
tex, ext
нет
Сравниваем строку text со строкой test по подстрокам длины 3.
tex
tes, est
нет
0
2
ext
tes, est
нет
Сравниваем строку test со строкой text по подстрокам длины 4.
test
text
нет
0
1
Сравниваем строку text со строкой test по подстрокам длины 4.
text
test
нет
0
1
Итого
8
20
