Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

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

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

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

По поводу фамилий - посмотрите здесь: 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
По умолчанию

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

готовая ф-я перевода ФИО в родительный падеж, стоит только вставить в модуль. по многим переметрам работает надежней представленных в топике
Код:
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
Сообщений: 842
По умолчанию

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

слегка напутал... переводит в дательный падеж.
правда сей код работает несколько по другому - не как ф-я, а как процедура
Выделяешь ячейку с ФИО - запускаешь процедуру - получаешь результат.
для перевода в форму "родительного падежа" придется немного ручками поработать
Код:
' 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
По умолчанию

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

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

http://morpher.ru/Products/XLL
morpher вне форума
Старый 15.11.2010, 19:48   #10
tae1980
Форумчанин
 
Регистрация: 02.02.2009
Сообщений: 842
По умолчанию

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

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


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