'Нечеткое сравнение строк: http://www.interface.ru/home.asp?artId=8900

'

'Аргументы: MaxLen - максимальная длина сравниваемых подстрок (см. описание алгоритма сравнения строк), _

Text1- первая строка, _

Text2 - вторая строка, _

CaseSensitive - тип сравнения (с учётом регистра или без учёта)

'Назначение: Нечеткое сравнение двух строк

'Возвращает: Возвращает коэффициент совпадения строк от 0 до 1 ( 0 - строки не совпадают, 1 - полное совпадение)

Public Type RetCount

lSubRows As Long

lngCountLike As Long

End Type

Public Function FuzzyMATCH(MaxLen%, Text1$, Text2$, Optional CaseSensitive% = 1) As Single

Dim gret As RetCount

Dim tret As RetCount

Dim iCurLen% 'текущая длина подстроки

If MaxLen = 0 Or Len(Text1) = 0 Or Len(Text2) = 0 Then

FuzzyMATCH = 0

Exit Function

End If

gret.lngCountLike = 0

gret.lSubRows = 0

For iCurLen = 1 To MaxLen

'Сравниваем строку A со строкой B

tret = MatchingStrings(Text1, Text2, iCurLen, CaseSensitive)

gret.lngCountLike = gret.lngCountLike + tret.lngCountLike

gret.lSubRows = gret.lSubRows + tret.lSubRows

'Сравниваем строку B со строкой A

tret = MatchingStrings(Text2, Text1, iCurLen, CaseSensitive)

gret.lngCountLike = gret.lngCountLike + tret.lngCountLike

gret.lSubRows = gret.lSubRows + tret.lSubRows

Next iCurLen

If gret.lSubRows = 0 Then

FuzzyMATCH = 0

Exit Function

End If

FuzzyMATCH = (gret.lngCountLike / gret.lSubRows)

End Function