Пользовательская функция (UDF) для перевода ФИО (фамилии, имя, отчества) в родительный падеж.
Новые версии функций (изменения от 2019 года) доступны в надстройке FIO + Propis
Эту функцию можно использовать как в коде программы, так и как формулу в ячейках листа Excel
(см. пример в прикреплённом файле)
PS: Функция является переделкой аналогичной UDF для склонения в дательном падеже.
Тестировал склонение на списке разнообразных ФИО (см. первый столбец в прикреплённом файле), и заведомо корректных результатах склонения (третий столбец)
Конечно, код не идеальный, - всегда можно найти ФИО, которые будут склоняться неверно.
Но, в целом, удалось добиться весьма неплохого результата (по сравнению с прежней версией кода, и другими аналогичными функциями)
Если вы используете функции склонения для формирования документов,
обратите внимание на специализированную надстройку FillDocuments,
которая позволит вам одним нажатием кнопки создать документы Word и Excel по шаблонам, а также выполнить рассылку писем.
В указанную надстройку включены самые последние версии функций склонения.
Пример использования:
Sub ПереводФИОвРодительныйПадеж() ' если фамилия, имя и отчество - в одной переменной (или ячейке) FIO$ = "Сидоров Иван Скотиныч" РодительныйПадеж$ = GenitiveCase(FIO$) Debug.Print РодительныйПадеж$ ' результат: Сидорова Ивана Скотиныча ' если фамилия, имя и отчество - в разных переменных (или ячейках) НетКого$ = GenitiveCase("Андреева", "Ольга", "Федоровна") Debug.Print НетКого$ ' результат: Андреевой Ольги Федоровны End Sub
Код функции GenitiveCase (версия от 29 января 2013 года):
<br />Option Compare Text ' эта строка нужна обязательно! (сравнение без учёта регистра)</p><p>Function GenitiveCase(sSurname$, Optional sName$, Optional sPatronymic$) As String<br /> ' Функция формирует родительный падеж из ФИО<br /> ' Параметры: sSurname - фамилия, sName - имя, sPatronymic - отчество<br /> ' © 2013 EducatedFool</p><p> Application.Volatile True ' автопересчёт формулы на листе<br /> sSurname$ = Replace(sSurname$, " - ", "-"): sSurname$ = Replace(Replace(sSurname$, " -", "-"), "- ", "-")</p><p> On Error Resume Next<br /> If sName$ = "" And sPatronymic$ = "" Then<br /> arr = Split(Application.Trim(sSurname$))<br /> sSurname$ = arr(0): sName$ = arr(1): sPatronymic$ = Replace(arr(2), ".", "")<br /> End If</p><p> ' пол теперь определяется иначе: что заканчивается на "вна" или "кызы" - то женщины, остальные - мужчины.<br /> Dim bMaleSex As Boolean: ' bMaleSex = (Right(sPatronymic, 1) = "ч" Or Right(sPatronymic, 4) = "оглы")<br /> bMaleSex = Not (Right(sPatronymic, 2) = "на" Or Right(sPatronymic, 4) = "кызы")</p><p>
If Len(sSurname) > 0 Then ' Фамилия<br /> arrSurname = Split(sSurname, "-")<br /> For i = LBound(arrSurname) To UBound(arrSurname) ' перебираем все части фамилий, содержащих дефис<br /> sRes = "": sSurnamePart = arrSurname(i)</p><p> If bMaleSex Then ' мужские фамилии<br /> Select Case Right(sSurnamePart, 1)<br /> Case "о", "и", "ы", "у", "э", "е", "ю": sRes = sSurnamePart<br /> Case "й": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ого"<br /> Case "ь": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "я"<br /> Case "я": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "и"<br /> Case "а": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ы"<br /> If UBound(arrSurname) > 0 And i = 0 Then sRes = sSurnamePart<br /> Case Else: sRes = sSurnamePart & "а"<br /> End Select</p><p> Select Case Right(sSurnamePart, 2) ' добавлено, для редких фамилий<br /> Case "ец": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ца"<br /> If LCase(sSurnamePart) Like "*[уеыаоэяиюё]ец" Then sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ца"<br /> If LCase(sSurnamePart) Like "*[!уеыаоэяиюё][!уеыаоэяиюё]ец" Then sRes = sSurnamePart & "а"<br /> Case "зе", "их", "ых": sRes = sSurnamePart<br /> Case "ий", "ой": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ого"<br /> If Len(sSurnamePart) <= 4 Then sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "я"<br /> If Right(sSurnamePart, 3) = "чий" Then sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "его"<br /> Case "уй": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "уя"<br /> End Select</p><p>
Else ' женские фамилии<br /> Select Case Right(sSurnamePart, 1)<br /> Case "о", "е", "э", "и", "ы", "у", "ю", "б", "в", "г", "д", "ж", "з", "к", "л", "м", "н", "п", _<br /> "р", "с", "т", "ф", "х", "ц", "ч", "ш", "щ", "ь", "й": sRes = sSurnamePart<br /> Case "а": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ой"<br /> Case "я": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ю"<br /> Case Else: sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "у"<br /> End Select</p><p> Select Case Right(sSurnamePart, 2) ' добавлено, для редких фамилий<br /> Case "ха": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "хи"<br /> Case "ла": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "лы"<br /> Case "ая": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ой"<br /> End Select</p><p> End If</p><p> ' не склоняются мужские и женские фамилии, оканчивающиеся на -о, -е, -э, -и, -ы, -у, -ю,<br /> ' а также на -а с предшествующей гласной<br /> If LCase(sSurnamePart) Like "*[уеыаоэяиюё]а" Then sRes = sSurnamePart</p><p> arrSurname(i) = sRes<br /> Next<br /> GenitiveCase = Join(arrSurname, "-") & " " ' соединяем части склоняемой фамилии обратно в одну строку<br /> End If</p><p>
If Len(sName) > 0 Then ' Имя<br /> NameException$ = GetGenitiveException(sName)<br /> If Len(NameException$) Then ' для имен-исключений<br /> GenitiveCase = GenitiveCase & NameException$<br /> Else ' имя не найдено в списке исключений<br /> If bMaleSex Then<br /> Select Case Right(sName, 1)<br /> Case "й", "ь": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "я"<br /> Case "а": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "ы"<br /> Case "я": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"<br /> Case "о": GenitiveCase = GenitiveCase & sName<br /> Case Else: GenitiveCase = GenitiveCase & sName & "а"<br /> End Select<br /> Else<br /> Select Case Right(sName, 1)<br /> Case "а": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "ы"<br /> Case "я": GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"<br /> Case Else: GenitiveCase = GenitiveCase & sName<br /> End Select<br /> End If<br /> End If<br /> GenitiveCase = GenitiveCase & " "<br /> End If</p><p>
If Len(sPatronymic) > 0 Then ' Отчество<br /> If Right(sPatronymic, 4) = "оглы" Or Right(sPatronymic, 4) = "кызы" Then<br /> GenitiveCase = GenitiveCase & sPatronymic<br /> Else<br /> If bMaleSex Then<br /> GenitiveCase = GenitiveCase & sPatronymic & "а"<br /> Else<br /> GenitiveCase = GenitiveCase & Mid(sPatronymic, 1, Len(sPatronymic) - 1) & "ы"<br /> End If<br /> End If<br /> End If<br /> GenitiveCase = Replace(GenitiveCase, "-", "- "): GenitiveCase = StrConv(GenitiveCase, vbProperCase): GenitiveCase = Replace(GenitiveCase, "- ", "-")<br />End Function<br />
<br />Function GetGenitiveException(ByVal txt$) As String ' склонение имён-исключений<br /> Select Case txt$<br /> Case "Павел": GetGenitiveException = "Павла"<br /> Case "Лев": GetGenitiveException = "Льва"<br /> Case "Пётр": GetGenitiveException = "Петра"<br /> Case "Любовь": GetGenitiveException = "Любови"</p><p> ' без изменения (не склоняются) - перечисляем через запятую<br /> Case "Али", "Бали": GetGenitiveException = txt$<br /> End Select<br />End Function<br />
Комментарии
Здравствуйте, Максим
Макрос предназначен только для ФИО - с прочими словами и фразами он работает некорректно
Чтобы регистр не изменялся, - удалите в макросе эту строку:
Здравствуйте. Испробовал Ваш макрос. Хочу сказать огромное спасибо и задать один вопрос:
Подскажите как сделать, чтобы второе слово в словосочетании писалось с маленькой буквы (если использовать макрос для склонения наименований организаций).
Спасибо за ответ, но у меня в таблице только фамилии с инициалами.
Если только фамилия нужна в родительном падеже, - то после склонения ФИО, при помощи формулы, оставьте только первое слово (текст до пробела)
В коде ничего менять не нужно.
Если в исходных данных - только фамилия (без имени-отчества), функция работать не будет, т.к. невозможно только по фамилии определить пол, а некоторые фамилии по-разному склоняются в зависимости от пола.
Пример - фамилии типа Лебедь, Головач, и т.д.
Если такая фамилия принадлежит женщине, - то она при склонении не меняется (а мужская - изменяется)
Если только фамилию нужно склонять, то что нужно обрезать?
А такое распространенное имя как Ольга в родительный падеж неправильно склоняет :-(
Я имел ввиду исключение склонения иностранных имён, оканчивающихся на "е" и "и".
У себя то я дописал.
Кстати, можете вспомнить русские имена таким же окончанием? Если нет, то можно просто внести в код.
А что мешает вам самостоятельно доработать код?
Это же очень просто, - надо взять строку
размножить её нужное количество раз,
поставив имена-исключения, и прописав для правильный результат склонения.
Кто-нибудь допилил скрипт? Не все правила для имён в мужском роде прописаны.
Огромное спасибо!
именно то что было нужно
Нет у меня такой функции. Была бы, — дал бы вам ссылку.
Сделать могу, но не бесплатно (много исключений, долго возиться с кодом)
так я не умею, поэтому и обращаюсь к специалистам в этом деле
Можно. Делайте.
Как сделаете — скиньте мне, я на сайте выложу.
А можно такой же файлик, только ещё с винительным падежом?
Чтобы три столбика подряд?
Отправить комментарий