Данная функция была портирована с Visual Basic несколько лет назад, в ходе решения задачи по поиску контрагентов или физлиц (уже не помню) по нечёткому совпадению.
Обнаружил случайно, копаясь в старых работах на платформе 7.7, и решил выложить в надежде, что кому-нибудь пригодится. Хочу заметить, что для платформы 8.1 может быть неактуально, в связи со штатными возможностями нечёткого поиска.
Оригинал функции и статья по теме находились по адресу «Как ваша фамилия», или Русский MetaPhone (сейчас там error 404, выложил здесь)
//________________________________________________________________________
//
// ** MetaPhone() algorithm **
// ** coded by Sergey (aka Porutchik) * 2006 http://forum.aeroion.ru
//
// based on description :
// © Peter Kankowski, 2002
// http://www.kankowski.narod.ru/dev/metaphoneru.htm
//
Функция MetaPhoneRu(Знач W) Экспорт
//Заменяет ЙО, ЙЕ и др.; неплохо оптимизирован.
//alf - алфавит кроме исключаемых букв, cns1 и cns2 - звонкие и глухие
//согласные, cns3 - согласные, перед которыми звонкие оглушаются,
// ch, ct - образец и замена гласных
alf = "ОЕАИУЭЮЯПСТРКЛМНБВГДЖЗЙФХЦЧШЩЁЫ";
cns1 = "БЗДВГ";
cns2 = "ПСТФК";
cns3 = "ПСТКБВГДЖЗФХЦЧШЩ";
ch = "ОЮЕЭЯЁЫ";
ct = "АУИИАИА";
//S, V - промежуточные строки, i - счётчик цикла, B - позиция
//найденного элемента, c$ - текущий символ, c_old$ - предыдущий символ
S= "";
V= "";
i= 0;
B= 0;
c= "";
old_c = "";
//Переводим в верхний регистр, оставляем только
//символы из alf и копируем в S:
W = Врег(W);
Для i = 1 По СтрДлина(W) Цикл
c = Сред(W, i, 1);
Если Найти(alf, c) > 0 Тогда
S = S + c;
КонецЕсли;
КонецЦикла;
Если СтрДлина(S) = 0 Тогда
Возврат "";
КонецЕсли;
//Сжимаем окончания:
Врем = Прав(S, 6);
Если Врем = "ОВСКИЙ" Тогда
S = Лев(S, СтрДлина(S) - 6) + "@";
ИначеЕсли Врем = "ЕВСКИЙ" Тогда
S = Лев(S, СтрДлина(S) - 6) + "#";
ИначеЕсли Врем = "ОВСКАЯ" Тогда
S = Лев(S, СтрДлина(S) - 6) + "$";
ИначеЕсли Врем = "ЕВСКАЯ" Тогда
S = Лев(S, СтрДлина(S) - 6) + "%";
Иначе
Врем = Прав(S, 4);
Если (Врем = "ИЕВА") ИЛИ (Врем = "ЕЕВА") Тогда
S = Лев(S, СтрДлина(S) - 4) + "9";
ИначеЕсли (Врем = "ОВНА") ИЛИ (Врем = "ЕВНА") Тогда
S = Лев(S, СтрДлина(S) - 4) + "8";
ИначеЕсли (Врем = "ОВИЧ") ИЛИ (Врем = "ЕВИЧ") Тогда
S = Лев(S, СтрДлина(S) - 4) + "7";
Иначе
Врем = Прав(S, 3);
Если (Врем = "ОВА") ИЛИ (Врем = "ЕВА") Тогда
S = Лев(S, СтрДлина(S) - 3) + "9";
ИначеЕсли Врем = "ИНА" Тогда
S = Лев(S, СтрДлина(S) - 3) + "1";
ИначеЕсли (Врем = "ИЕВ") ИЛИ (Врем = "ЕЕВ") Тогда
S = Лев(S, СтрДлина(S) - 3) + "4";
ИначеЕсли Врем = "НКО" Тогда
S = Лев(S, СтрДлина(S) - 3) + "3";
Иначе
Врем = Прав(S, 2);
Если (Врем = "ОВ") ИЛИ (Врем = "ЕВ") Тогда
S = Лев(S, СтрДлина(S) - 2) + "4";
ИначеЕсли Врем = "АЯ" Тогда
S = Лев(S, СтрДлина(S) - 2) + "6";
ИначеЕсли (Врем = "ИЙ") ИЛИ (Врем = "ЫЙ") Тогда
S = Лев(S, СтрДлина(S) - 2) + "7";
ИначеЕсли (Врем = "ЫХ") ИЛИ (Врем = "ИХ") Тогда
S = Лев(S, СтрДлина(S) - 2) + "5";
ИначеЕсли (Врем = "ИН") Тогда
S = Лев(S, СтрДлина(S) - 2) + "8";
ИначеЕсли (Врем = "ИК") ИЛИ (Врем = "ЕК") Тогда
S = Лев(S, СтрДлина(S) - 2) + "2";
ИначеЕсли (Врем = "УК") ИЛИ (Врем = "ЮК") Тогда
S = Лев(S, СтрДлина(S) - 2) + "0";
КонецЕсли;
КонецЕсли;
КонецЕсли;
КонецЕсли;
//Оглушаем последний символ, если он - звонкий согласный:
B = Найти(cns1, Прав(S, 1));
Если B > 0 Тогда
S = Сред(S, СтрДлина(S)-1, 1);
S = S + Сред(cns2, B, 1);
КонецЕсли;
old_c = " ";
//Основной цикл:
Для i = 1 По СтрДлина(S) Цикл
c = Сред(S, i, 1);
B = Найти(ch, c);
Если B > 0 Тогда //Если гласная
Если (old_c = "Й") ИЛИ (old_c = "И") Тогда
Если (c = "О") ИЛИ (c = "Е") Тогда //Буквосочетания с гласной
old_c = "И";
V = Сред(V, СтрДлина(V)-1, 1);
V = V + old_c;
Иначе //Если не буквосочетания с гласной, а просто гласная
Если c <> old_c Тогда
V = V + Сред(ct, B, 1);
КонецЕсли;
КонецЕсли;
Иначе //Если не буквосочетания с гласной, а просто гласная
Если c <> old_c Тогда
V = V + Сред(ct, B, 1);
КонецЕсли;
КонецЕсли;
Иначе //Если согласная
Если c <> old_c Тогда //для «Аввакумов»
Если Найти(cns3, c) > 0 Тогда //Оглушение согласных
B = Найти(cns1, old_c);
КонецЕсли;
Если B > 0 Тогда
old_c = Сред(cns2, B, 1);
V = Сред(V, СтрДлина(V)-1, 1);
V = V + old_c;
КонецЕсли;
Если c <> old_c Тогда
V = V + c; //для «Шмидт»
КонецЕсли;
КонецЕсли;
КонецЕсли;
old_c = c;
КонецЦикла;
Возврат V;
КонецФункции // ** MetaPhoneRu() algorithm **