Книга: Excel. Трюки и эффекты
Склонение фамилии, имени и отчества
Склонение фамилии, имени и отчества
Трюк, который мы рассмотрим в данном разделе, удобно применять при работе со списками ФИО. С его помощью можно быстро переводить требуемые ФИО в родительный или дательный падеж. Чтобы достичь подобного эффекта, следует воспользоваться макросом, код которого приведен в листинге 3.82 (данный код записывается в стандартном модуле).
Листинг 3.82. Склонение ФИО
Public Sub PossessiveCase()
' Склоняем ФИО в родительный падеж
Dim strName1 As String, strName2 As String, strName3 As
String
strName1 = dhGetName(ActiveCell, 1) ' Выделяем имя
strName2 = dhGetName(ActiveCell, 2) ' Выделяем фамилию
strName3 = dhGetName(ActiveCell, 3) ' Выделяем отчество
' Если в ячейке менее трех слов – закрытие процедуры
If strName1 = "" Or strName2 = "" Or strName3 = "" Then Exit
Sub
' Склоняем
Cells(ActiveCell.Row, ActiveCell.Column) = dhPossessive( _
strName1, strName2, strName3)
End Sub
Public Sub DativeCase()
' Объявление переменных
Dim strName1 As String, strName2 As String, strName3 As
String
strName1 = dhGetName(ActiveCell, 1)
strName2 = dhGetName(ActiveCell, 2)
strName3 = dhGetName(ActiveCell, 3)
' Если в ячейке менее трех слов – закрытие процедуры
If Len(strName1) = 0 Or Len(strName2) = 0 Or Len(strName3) = 0 _
Then Exit Sub
Cells(ActiveCell.Row, ActiveCell.Column) = dhDative( _
strName1, strName2, strName3)
End Sub
Function dhPossessive(strName1 As String, strName2 As String, _
strName3 As String) As String
Dim fMan As Boolean
' Определяем, мужские ФИО или женские
fMan = (Right(strName3, 1) = "ч")
' Склонение фамилии в родительный падеж
If Len(strName1) > 0 Then
If fMan Then
' Склонение мужской фамилии
Select Case Right(strName1, 1)
Case "о", "и", "я", "а"
dhPossess ive = strName1
Case "й"
dhPossessive = Mid(strName1, 1, Len(strName1) – 2) + «ого»
Case Else
dhPossessive = strName1 + "а"
End Select
Else
' Склонение женской фамилии
Select Case Right(strName1, 1)
Case "о", "и", "б", "в", "г", "д", "ж", "з", "к", "л", _
"м", "н", "п", "р", "с", "т", "ф", "х", "ц", "ч", _
"ш", "щ", "ь"
dhPossessive = strName1
Case "я"
dhPossessive = Mid(strName1, 1, Len(strName1) – 2) & «ой»
Case Else
dhPossessive = Mid(strName1, 1, Len(strName1) – 1) & «ой»
End Select
End If
dhPossessive = dhPossessive & " "
End If
' Склонение имени в родительный падеж
If Len(strName2) > 0 Then
If fMan Then
' Склонение мужского имени
Select Case Right(strName2, 1)
Case "й", "ь"
dhPossessive = dhPossessive & Mid(strName2, _
1, Len(strName2) – 1) & "я"
Case Else
dhPossessive = dhPossessive & strName2 & "а"
End Select
Else
' Склонение женского имени
Select Case Right(strName2, 1)
Case "а"
Select Case Mid(strName2, Len(strName2) – 1, 1)
Case "и", "г"
dhPossessive = dhPossessive & Mid( _
strName2, 1, Len(strName2) – 1) & "и"
Case Else
dhPossessive = dhPossessive & Mid(strName2, _
1, Len(strName2) – 1) & "ы"
End Select
Case "я"
If Mid(strName2, Len(strName2) – 1, 1) = "и" Then
dhPossessive = dhPossessive & Mid(strName2, _
1, Len(strName2) – 1) & "и"
Else
dhPossessive = dhPossessive & Mid(strName2, _
1, Len(strName2) – 1) & "и"
End If
Case "ь"
dhPossessive = dhPossessive & Mid(strName2, _
1, Len(strName2) – 1) & "и"
Case Else
dhPossessive = dhPossessive & strName2
End Select
End If
dhPossessive = dhPossessive & " "
End If
' Склонение отчества в родительный падеж
If Len(strName3) > 0 Then
If fMan Then
dhPossessive = dhPossessive & strName3 & "а"
Else
dhPossessive = dhPossessive & Mid(strName3, 1, _
Len(strName3) – 1) & "ы"
End If
End If
End Function
Function dhDative(strName1 As String, strName2 As String, _
strName3 As String) As String
Dim fMan As Boolean
' Определяем, мужские ФИО или женские
fMan = (Right(strName3, 1) = "ч")
' Склонение фамилии в дательный падеж
If Len(strName1) > 0 Then
If fMan Then
' Склонение мужской фамилии
Select Case Right(strName1, 1)
Case "о", "и", "я", "а"
dhDative = strName1
Case "й"
dhDative = Mid(strName1, 1, Len(strName1) – 2) + «ому»
Case Else
dhDative = strName1 + "у"
End Select
Else
' Склонение женской фамилии
Select Case Right(strName1, 1)
Case "о", "и", "б", "в", "г", "д", "ж", "з", "к",
"л", _ "м", "н", "п", "р", "с", "т", "ф", "х", "ц", "ч", "ш", _
"щ", "ь"
dhDative = strName1
Case "я"
dhDative = Mid(strName1, 1, Len(strName1) – 2)
& «ой»
Case Else
dhDative = Mid(strName1, 1, Len(strName1) – 1)
& «ой»
End Select
End If
dhDative = dhDative & " "
End If
' Склонение имени в дательный падеж
If Len(strName2) > 0 Then
If fMan Then
'Склонение мужского имени
Select Case Right(strName2, 1)
Case "й", "ь"
dhDative = dhDative & Mid(strName2, 1, _
Len(strName2) – 1) & "ю"
Case Else
dhDative = dhDative & strName2 & "у"
End Select
Else
' Склонение женского имени
Select Case Right(strName2, 1)
Case "а", "я"
If Mid(strName2, Len(strName2) – 1, 1) = "и" Then
dhDative = dhDative & Mid(strName2, 1, _
Len(strName2) – 1) & "и"
Else
dhDative = dhDative & Mid(strName2, 1, _
Len(strName2) – 1) & "е"
End If
Case "ь"
dhDative = dhDative & Mid(strName2, 1, _
Len(strName2) – 1) & "и"
Case Else
dhDative = dhDative & strName2
End Select
End If
dhDative = dhDative & " "
End If
' Склонение отчества в дательный падеж
If Len(strName3) > 0 Then
If fMan The
dhDative = dhDative & strName3 & "у"
Else
dhDative = dhDative & Mid(strName3, 1, Len(strName3)
– 1) & "е"
End If
End If
End Function
Function dhGetName(strString As String, intNum As Integer)
' Функция возвращает слово с номером intNum во входной строке _
strString
Dim strTemp As String
Dim intWord As Integer
Dim intSpace As Integer
' Удаление пробелов по краям строки
strTemp = Trim(strString)
' Просмотр строки (до слова с нужным номером)
For intWord = 1 To intNum – 1
' Поиск следующего пробела
intSpace = InStr(strTemp, " ")
If intSpace = 0 Then
' Строка закончилась
intSpace = Len(strTemp)
End If
' Строка strTemp теперь начинается со слова с номером
intWord
strTemp = Trim(Right(strTemp, Len(strTemp) – intSpace))
Next intWord
' Выделение нужного слова (по пробелу после него)
intSpace = InStr(strTemp, " ")
If intSpace = 0 Then
intSpace = Len(strTemp)
End If
dhGetName = Trim(Left(strTemp, intSpace))
End Function
Чтобы ФИО отобразились в родительном падеже, следует установить курсор в ячейку с этими ФИО и запустить макрос PossessiveCase; в дательном падеже – макрос DativeCase (после написания кода эти макросы будут доступны в окне выбора макросов).
Внимание!
Для реализации трюка необходимо соблюдать условие – ячейка должна содержать не менее трех слов. В противном случае операция выполнена не будет.
Следует учитывать, что в ячейке сначала должна следовать фамилия, за ней – имя, и затем – отчество.
Данный макрос не всегда способен корректно обрабатывать сложные имена и фамилии.
- Подсчет количества открытий файла
- Получение «закрытой» информации
- Произвольный текст в строке состояния
- Быстрое изменение заголовка окна
- Ввод данных с помощью диалогового окна
- Применение функции без ввода ее в ячейку
- Скрытие строк и столбцов от посторонних
- Быстрое выделение ячеек, расположенных через интервал
- Определение количества ячеек в диапазоне и суммы их значений
- Подсчет именованных объектов
- Быстрый поиск курсора
- Поиск начала и окончания диапазона, содержащего данные
- Трюки с примечаниями
- Дополнение панели инструментов
- Примеры создания панелей инструментов
- Формирование пользовательского меню
- Проверка наличия файла по указанному пути
- Автоматизация удаления файлов
- Перечень имен листов в виде гиперссылок
- Удаление пустых строк на рабочем листе
- Запись текущих данных в текстовый файл
- Экспорт и импорт данных
- Одновременное умножение всех данных диапазона
- Преобразование таблицы Excel в HTML-формат
- Поиск данных нештатными средствами
- Включение автофильтра с помощью макроса
- Трюки с форматированием
- Вывод информации о текущем документе
- Вывод результата расчетов в отдельном окне
- Вывод разрешения монитора
- Что открыто в данный момент?
- Создание бегущей строки
- Мигающая ячейка
- Вращающиеся автофигуры
- Вызов таблицы цветов
- Создание калькулятора
- Еще о создании пользовательских меню
- Склонение фамилии, имени и отчества
- Получение информации об используемом принтере
- Вывод текущей даты и времени
- Автоматическое создание документов Word на основе табличных данных Excel
- Создание списка панелей инструментов и контекстных меню
- Создание списка пунктов главного меню Excel
- Создание списка пунктов контекстных меню
- Отображение панели инструментов при определенном условии
- Скрытие и отображение панелей инструментов
- Создание меню на основе данных рабочего листа
- Создание контекстного меню
- Просмотр содержимого папки
- Получение информации о состоянии дисков
- Расчет среднего арифметического
- Вывод списка доступных шрифтов
- Создание раскрывающегося списка
- Добавление команды на вкладку
- Получение доменного имени
- Можно ли входить в систему без ввода имени и пароля?
- Императив и аппликатив (применимость)
- Элементы по имени тегов
- 12.7.2. Раскрытие имени файла: glob() и globfree()
- Как применить эти условия договора к своим новым программам
- Определение имени узла
- 0.2 Применимость СПО при реализации «Обязательного минимума...»
- 2. Существующие модели менеджмента (управления), применимые для обеспечения информационной безопасности бизнеса
- Как применить эти требования к новым программным продуктам
- 31. Поздравление с именинами
- Какова длина второго имени?