Данная VBA функция позволяет склонять воинские звания и некоторые должности.
См. примеры должностей и званий, поддерживаемых этой функцией:
https://excelvba.ru/programmes/FillDocuments/manuals/SheetFunctions/rank
Можно использовать в виде формулы на листе Excel:
=Склонение( Ячейка_с_Исходным_Текстом; НомерПадежа )
Поддерживаются 4 падежа:
- 1 - родительный
- 2 - дательный
- 3 - винительный
- 4 - творительный
Вставьте этот код в стандартный модуль вашего файла Excel
(см. пример в прикреплённом файле)
Option Compare Text ' эта строка нужна обязательно! (сравнение без учёта регистра) Public Function RankCase(ByRef txt, ByVal CaseIndex&) As Boolean ' © 2025 ExcelVBA.ru для надстройки FillDocuments ' склонение воинских званий и некоторых должностей ' возвращает TRUE если в тексте txt было найдено звание ' CaseIndex&: 1 - родительный, 2 - дательный, 3 - винительный, 4 - творительный If Len(Trim(txt)) < 3 Then Exit Function On Error Resume Next Dim arr, i&, word$, pref$ arr = Split(Replace(txt, Chr(160), " "), " ") For i = LBound(arr) To UBound(arr) ' перебираем все слова word$ = arr(i): pref$ = "": If word Like "?*-?*" Then pref$ = Left(word$, InStrRev(word$, "-")): word$ = Mid(word$, Len(pref$) + 1) Select Case word$ ' склоняем только заданные слова Case "младший", "старший", "командующий", "ведущий", "коммерческий" RankCase = True: word$ = Left(word$, Len(word$) - 2) & Choose(CaseIndex&, "его", "ему", "его", "им") Case "главный", "рядовой", "корабельный", "генеральный", "налоговый", "самозанятый" RankCase = True: word$ = Left(word$, Len(word$) - 2) & Choose(CaseIndex&, "ого", "ому", "ого", "ым") Case "Ефрейтор", "Сержант", "Прапорщик", "Лейтенант", "Капитан", "Майор", "Подполковник", "Полковник", "Маршал", _ "Матрос", "Мичман", "Адмирал", "Летчик", "Штурман", "Командир", "Солдат", "Инспектор", "Инженер", "Специалист", _ "Директор", "Начальник", "Министр", "Инструктор", "Механик", "Врач", "Менеджер", "Бухгалтер", "Юрист", "Экономист", "Логист" RankCase = True: word$ = word$ & Choose(CaseIndex&, "а", "у", "а", "ом") Case "Старшина" RankCase = True: word$ = Left(word$, Len(word$) - 1) & Choose(CaseIndex&, "ы", "е", "у", "ой") Case "Заместитель", "Руководитель", "Секретарь", "Водитель", "Исполнитель" RankCase = True: word$ = Left(word$, Len(word$) - 1) & Choose(CaseIndex&, "я", "ю", "я", "ем") End Select arr(i) = pref$ & word$ Next i If RankCase Then txt = Join(arr, " ") ' возвращаем результат End Function Public Function Склонение(ByVal txt, ByVal CaseIndex&) As String ' для вызова с листа Excel: формула =СКЛОНЕНИЕ( ДОЛЖНОСТЬ; НомерПадежа ) If RankCase(txt, CaseIndex&) Then Склонение = txt End Function
Комментарии
Отправить комментарий