Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Название темы включает слова - "Помогите", "Спасите", "Срочно"
Название темы не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте >>>правила <<< и заново правильно создайте тему.
 
Опции темы
Старый 05.07.2009, 21:31   #1
tae1980
Участник клуба
 
Регистрация: 02.02.2009
Адрес: г. Саратов
Сообщений: 820
Репутация: 59
По умолчанию Склонения слов по падежам

Есть ли способ склонять слова по падежам? В частности фамилии и цифры?
__________________
С уважением, Алексей.
tae1980 вне форума  
Старый 05.07.2009, 21:46   #2
Евгений ГВС
Пользователь
 
Регистрация: 28.05.2009
Сообщений: 43
Репутация: 10
По умолчанию

Встроенных функций нет, по-моему тема уже затрагивалась.
Евгений ГВС вне форума  
Старый 05.07.2009, 21:53   #3
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Адрес: Россия, Урал
Сообщений: 6,840
Репутация: 1286

skype: ExcelVBA.ru
По умолчанию

По поводу фамилий - посмотрите здесь: http://www.programmersforum.ru/showthread.php?t=56554

А с цифрами всё намного проще - есть готовые надстройки, позволяющие переводить числа в слова в разных падежах.
Осталось только поискать.
Впрочем, возможно, что в некоторых из этих надстроек есть функции и для обработки фамилий.

У меня таких надстроек нет, но они мне очень часто попадались на форумах по Excel.

(добавлено позже)
На базе функции, предложенной diment, сделал чуть более универсальную UDF для перевода ФИО в дательный падеж:
http://excelvba.ru/code/DativeCase

------------- новые версии функций склонения, от 29 января 2013 г. --------------------
Функции склонения, для использования в макросах,
или в качестве пользовательской функции на листе Excel:

Родительный падеж на VBA
Дательный падеж на VBA

-------------

Последний раз редактировалось EducatedFool; 29.01.2013 в 02:05.
EducatedFool вне форума  
Старый 08.07.2009, 04:09   #4
mchip
Участник клуба
 
Регистрация: 24.06.2008
Адрес: Россия
Сообщений: 516
Репутация: 38

skype: maxim_chip
По умолчанию

Натолкнулся на реализацию библиотеки склонения фамилий. Есть возможность использовать в VBA.
Кому интересно вот ссылка
http://www.delphikingdom.com/asp/vie..._1647532249334
__________________
Можно сделать все! Было бы время, да деньги...
mchip вне форума  
Старый 08.07.2009, 14:00   #5
diment
Пользователь
 
Регистрация: 16.06.2009
Адрес: Ставропольский край
Сообщений: 20
Репутация: 25
По умолчанию

готовая ф-я перевода ФИО в родительный падеж, стоит только вставить в модуль. по многим переметрам работает надежней представленных в топике
Код:
Function GenitiveCaseInCell1(s As String)
    Dim s1 As String, s2 As String, s3 As String
    s1 = ChooseWord(s, 1)
    s2 = ChooseWord(s, 2)
    s3 = ChooseWord(s, 3)
    If Len(s1) = 0 Or Len(s2) = 0 Or Len(s3) = 0 Then Exit Function
    GenitiveCaseInCell1 = GenitiveCase(s1, s2, s3)
End Function

Private Function GenitiveCase(sSurname As String, sName As String, sPatronymic As String) As String
  Dim bMaleSex As Boolean
    
  bMaleSex = (Right(sPatronymic, 1) = "ч")
        
'   Фамилия
  If Len(sSurname) > 0 Then
    If bMaleSex Then
        Select Case Right(sSurname, 1)
            Case "о", "и", "я", "а"
                GenitiveCase = sSurname
            Case "й"
                GenitiveCase = Mid(sSurname, 1, Len(sSurname) - 2) + "ого"
            Case Else
                GenitiveCase = sSurname + "а"
        End Select
    Else
        Select Case Right(sSurname, 1)
            Case "о", "и", "б", "в", "г", "д", "ж", "з", "к", "л", "м", "н", "п", "р", "с", "т", "ф", "х", "ц", "ч", "ш", "щ", "ь"
                GenitiveCase = sSurname
            Case "я"
                GenitiveCase = Mid(sSurname, 1, Len(sSurname) - 2) & "ой"
            Case Else
                GenitiveCase = Mid(sSurname, 1, Len(sSurname) - 1) & "ой"
        End Select
    End If
    GenitiveCase = GenitiveCase & " "
  End If
'   Имя
  If Len(sName) > 0 Then
    If bMaleSex Then
        Select Case Right(sName, 1)
            Case "й", "ь"
                GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "я"
            Case Else
                GenitiveCase = GenitiveCase & sName & "а"
        End Select
    Else
        Select Case Right(sName, 1)
            Case "а"
                Select Case Mid(sName, Len(sName) - 1, 1)
                    Case "и", "г"
                        GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"
                    Case Else
                        GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "ы"
                End Select
            Case "я"
                If Mid(sName, Len(sName) - 1, 1) = "и" Then
                    GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"
                Else
                    GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"
                End If
            Case "ь"
                GenitiveCase = GenitiveCase & Mid(sName, 1, Len(sName) - 1) & "и"
            Case Else
                GenitiveCase = GenitiveCase & sName
        End Select
    End If
    GenitiveCase = GenitiveCase & " "
  End If
'   Отчество
  If Len(sPatronymic) > 0 Then
    If bMaleSex Then
            GenitiveCase = GenitiveCase & sPatronymic & "а"
    Else
            GenitiveCase = GenitiveCase & Mid(sPatronymic, 1, Len(sPatronymic) - 1) & "ы"
    End If
  End If
End Function
' ChooseWord - выделение i-го слова из строки
' Параметры: sString - строка
'            iNum    - номер слова (1, 2,...)
' Результат: i-е слово или пустая строка, если такого слова нет

Private Function ChooseWord(sString As String, iNum As Integer)
    Dim sTemp As String
    Dim i As Integer, iPos As Integer
    
    sTemp = Trim(sString)
    For i = 1 To iNum - 1
        iPos = InStr(sTemp, " ")
        If iPos = 0 Then iPos = Len(sTemp)
        sTemp = Trim(Right(sTemp, Len(sTemp) - iPos))
    Next i
    iPos = InStr(sTemp, " ")
    If iPos = 0 Then iPos = Len(sTemp)
    ChooseWord = Trim(Left(sTemp, iPos))
End Function
в наличии есть так же для перевода в творительный падеж, если будет интересно сброшу
diment вне форума  
Старый 29.07.2009, 20:00   #6
tae1980
Участник клуба
 
Регистрация: 02.02.2009
Адрес: г. Саратов
Сообщений: 820
Репутация: 59
По умолчанию

Цитата:
Сообщение от diment Посмотреть сообщение
готовая ф-я перевода ФИО в родительный падеж, стоит только вставить в модуль. по многим переметрам работает надежней представленных в топике
Код:
Function GenitiveCaseInCell1(s As String)
End Function
Вот спасибо!
Цитата:
Сообщение от diment Посмотреть сообщение
в наличии есть так же для перевода в творительный падеж, если будет интересно сброшу
Если не сложно, был бы очень признателен.
__________________
С уважением, Алексей.
tae1980 вне форума  
Старый 30.07.2009, 09:17   #7
diment
Пользователь
 
Регистрация: 16.06.2009
Адрес: Ставропольский край
Сообщений: 20
Репутация: 25
По умолчанию

слегка напутал... переводит в дательный падеж.
правда сей код работает несколько по другому - не как ф-я, а как процедура
Выделяешь ячейку с ФИО - запускаешь процедуру - получаешь результат.
для перевода в форму "родительного падежа" придется немного ручками поработать
Код:
' DativeCaseInCell - дательный падеж от ФИО, записанных
'                    в текущей ячейке MS Excel
'
'   Текущая ячейка должна содержать следующую информацию:
'   фамилия, имя и отчество (именно в таком порядке)

Public Sub DativeCaseInCell()
    Dim s1 As String, s2 As String, s3 As String
    
    s1 = ChooseWord(ActiveCell, 1)
    s2 = ChooseWord(ActiveCell, 2)
    s3 = ChooseWord(ActiveCell, 3)
    If Len(s1) = 0 Or Len(s2) = 0 Or Len(s3) = 0 Then Exit Sub

    Cells(ActiveCell.Row, ActiveCell.Column) = DativeCase(s1, s2, s3)
End Sub

' DativeCase - формирование дательного падежа от ФИО
'
' Параметры: sSurname    - фамилия
'            sName       - имя
'            sPatronymic - отчество
'
' Результат: ФИО в дательном падеже

Private Function DativeCase(sSurname As String, sName As String, sPatronymic As String) As String
  Dim bMaleSex As Boolean
    
  bMaleSex = (Right(sPatronymic, 1) = "ч")
        
'   Фамилия

  If Len(sSurname) > 0 Then
    If bMaleSex Then
        Select Case Right(sSurname, 1)
            Case "о", "и", "я", "а"
                DativeCase = sSurname
            Case "й"
                DativeCase = Mid(sSurname, 1, Len(sSurname) - 2) + "ому"
            Case Else
                DativeCase = sSurname + "у"
        End Select
    Else
        Select Case Right(sSurname, 1)
            Case "о", "и", "б", "в", "г", "д", "ж", "з", "к", "л", "м", "н", "п", "р", "с", "т", "ф", "х", "ц", "ч", "ш", "щ", "ь"
                DativeCase = sSurname
            Case "я"
                DativeCase = Mid(sSurname, 1, Len(sSurname) - 2) & "ой"
            Case Else
                DativeCase = Mid(sSurname, 1, Len(sSurname) - 1) & "ой"
        End Select
    End If
    DativeCase = DativeCase & " "
  End If

'   Имя

  If Len(sName) > 0 Then
    If bMaleSex Then
        Select Case Right(sName, 1)
            Case "й", "ь"
                DativeCase = DativeCase & Mid(sName, 1, Len(sName) - 1) & "ю"
            Case Else
                DativeCase = DativeCase & sName & "у"
        End Select
    Else
        Select Case Right(sName, 1)
            Case "а", "я"
                If Mid(sName, Len(sName) - 1, 1) = "и" Then
                    DativeCase = DativeCase & Mid(sName, 1, Len(sName) - 1) & "и"
                Else
                    DativeCase = DativeCase & Mid(sName, 1, Len(sName) - 1) & "е"
                End If
            Case "ь"
                DativeCase = DativeCase & Mid(sName, 1, Len(sName) - 1) & "и"
            Case Else
                DativeCase = DativeCase & sName
        End Select
    End If
    DativeCase = DativeCase & " "
  End If

'   Отчество

  If Len(sPatronymic) > 0 Then
    If bMaleSex Then
            DativeCase = DativeCase & sPatronymic & "у"
    Else
            DativeCase = DativeCase & Mid(sPatronymic, 1, Len(sPatronymic) - 1) & "е"
    End If
  End If
End Function

' ChooseWord - выделение i-го слова из строки
'
' Параметры: sString - строка
'            iNum    - номер слова (1, 2,...)
'
' Результат: i-е слово или пустая строка, если такого слова нет


Private Function ChooseWord(sString As String, iNum As Integer)
    Dim sTemp As String
    Dim i As Integer, iPos As Integer
    
    sTemp = Trim(sString)
    For i = 1 To iNum - 1
        iPos = InStr(sTemp, " ")
        If iPos = 0 Then iPos = Len(sTemp)
        sTemp = Trim(Right(sTemp, Len(sTemp) - iPos))
    Next i
    iPos = InStr(sTemp, " ")
    If iPos = 0 Then iPos = Len(sTemp)
    ChooseWord = Trim(Left(sTemp, iPos))
    
End Function

Последний раз редактировалось diment; 30.07.2009 в 09:19.
diment вне форума  
Старый 28.05.2010, 15:48   #8
Yakovenko
 
Регистрация: 28.05.2010
Сообщений: 4
Репутация: 10
По умолчанию

Всем привет. Если кому не лень помогите разобраться со склонением. Попытался написать функцию для склонения в винительный падеж ФИО на основе приведенного выше родительного и... ничего не получилось. Помогите позалуйсиа
P. S. С библиотекой склонений вообще беда, так что лучше отдельно функцию или код подкинте если кто может.
Yakovenko вне форума  
Старый 15.11.2010, 20:14   #9
morpher
 
Регистрация: 15.11.2010
Сообщений: 3
Репутация: 10
По умолчанию

Есть платный add-in, называется Morpher.XLL. Работает очень хорошо – склоняет ФИО, должности, подразделения и все, что угодно:

http://morpher.ru/Products/XLL
morpher вне форума  
Старый 15.11.2010, 20:48   #10
tae1980
Участник клуба
 
Регистрация: 02.02.2009
Адрес: г. Саратов
Сообщений: 820
Репутация: 59
По умолчанию

Цитата:
Сообщение от morpher Посмотреть сообщение
Есть платный add-in, называется Morpher.XLL. Работает очень хорошо – склоняет ФИО, должности, подразделения и все, что угодно:
http://morpher.ru/Products/XLL
Есть правило, что проектах расчитанных на продолжительное время с запасам на модернизацию ни в коем случае НЕЛЬЗЯ использовать платные внешние модули (да и вообще внешних чужих модулей). Это на корню убивает все плюсы самостоятельной разработки, так как практически уничтожает возможность модернизации и ставит весь проект в зависимость от одной мелочи.
Так же не понятно как искать крайних. Предположим в результате малозначимой ошибки (которая столь мала, что раньше ни разу себя не проявила) в вашем модуле организация (человек) понес серъездные убытки (список причин может быть огромен). К кому вопросы: почему так произошло и кто будет возмещать убытки? К программистам? Так они скажует - не наш косяк, мол ошибка в чужом модуле, идите туда. То есть к тебе. :)) Модуль же платный...
И т.п. и т.д.

Так что купить его у тебя может либо дурак, либо лентяй. Хотя и тех и других в нашей стране хватает.
__________________
С уважением, Алексей.
tae1980 вне форума  
Закрытая тема

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Дана строка, состоящая из нескольких слов. Найти количество слов, которые содержат хотя бы одну букву "А" Mashaa Помощь студентам 13 09.12.2009 14:28
Составить в алфавитном порядке список всех слов, встречающихся в тексте, и количество этих слов. KAPAHDAW Паскаль 2 17.02.2009 02:19
Вывод слов jakson_sun Общие вопросы C/C++ 1 22.01.2009 18:12
c\c++ массив слов FreeJaile Общие вопросы C/C++ 7 04.04.2008 00:39
Вставка слов )Игнат( Общие вопросы Delphi 1 16.03.2008 22:58


07:04.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.