СКЛОНЯТЬ СЛОВО

Пользователь

Сообщений: 23 Регистрация: 01.01.1970

11.04.2008 18:34:14

Не нашел никакой возможности просклонять слово встроенными ф-ями пришлось написать свою ф-ю котораяя склоняла бы слово по падежам.... может я это зря и есть какой-то более простой способ???

Но дело не в этом эта ф-я при обращении к ней выдает нелепую ошибку (Else without If....) я все проверил этой ошибки быть не должно.... Да и еще в 1С эта ф-я работает безотказно....

Такой вопрос может ли это быть связанно с глюками во встр VBA???? и еще если кто сталкивался с необходимостью склонять слова может поможет.

Код функции скину, если потребуется...

krot

Пользователь

Сообщений: 23 Регистрация: 01.01.1970

11.04.2008 21:15:36

Кидаю код мож кто разберется???

Function СклонятьСлово(ByVal п_Слово As String, ByVal п_Падеж As String, ByVal п_Пол As String, ByVal п_Фамилия As Byte) As String
' Определение локальных переменных
Dim СС, Падеж, ПБ1, ПБ2, ПБ3, Пол, Окончание As String
Dim ДлСС, Фам As Byte

СС = LCase(Trim(п_Слово))
Падеж = Left(LCase(Trim(п_Падеж)), 1)
ПБ1 = Right(СС, 1)
ПБ2 = Left(Right(СС, 2), 1)
ПБ3 = Left(Right(СС, 3), 1)
Пол = Left(LCase(Trim(п_Пол)), 1)

ДлСС = Len(СС)
Фам = п_Фамилия

' Обработка нестандартных слов
If СС = "лев" Then
If Падеж = "р" Then Окончание = "ьва"
ElseIf Падеж = "д" Then Окончание = "ьву"
ElseIf Падеж = "в" Then Окончание = "ьва"
ElseIf Падеж = "т" Then Окончание = "ьвом"
ElseIf Падеж = "п" Then Окончание = "ьве"
End If
СС = Left(CC, 1) & Окончание
СклонятьСлово = СС
Exit Function

ElseIf СС = "павел" Then
If Падеж = "р" Then Окончание = "ла"
ElseIf Падеж = "д" Then Окончание = "лу"
ElseIf Падеж = "в" Then Окончание = "ла"
ElseIf Падеж = "т" Then Окончание = "лом"
ElseIf Падеж = "п" Then Окончание = "ле"
End If
СС = Left(CC, 3) & Окончание
СклонятьСлово = СС
Exit Function
End If

' Обработка окончания
If ПБ1 = "а" Then
If ПБ2 = "к" Then
If Падеж = "р" Then Окончание = "и"
ElseIf Падеж = "д" Then Окончание = "е"
ElseIf Падеж = "в" Then Окончание = "у"
ElseIf Падеж = "т" Then Окончание = "ой"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = Left(CC, ДлСС - 1) & Окончание
ElseIf ПБ2 = "ц" Then
If Падеж = "р" Then Окончание = "ы"
ElseIf Падеж = "д" Then Окончание = "е"
ElseIf Падеж = "в" Then Окончание = "у"
ElseIf Падеж = "т" Then Окончание = "ей"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = Left(CC, ДлСС - 1) & Окончание
Else
If (Фам = 1) And (Пол = "ж") Then
If (ПБ2 = "в") Or (ПБ2 = "н") Then
If Падеж = "р" Then Окончание = "ой"
ElseIf Падеж = "д" Then Окончание = "ой"
ElseIf Падеж = "в" Then Окончание = "у"
ElseIf Падеж = "т" Then Окончание = "ой"
ElseIf Падеж = "п" Then Окончание = "ой"
End If
СС = Left(CC, ДлСС - 1) & Окончание
Else
If Падеж = "р" Then Окончание = "ы"
ElseIf Падеж = "д" Then Окончание = "е"
ElseIf Падеж = "в" Then Окончание = "у"
ElseIf Падеж = "т" Then Окончание = "ой"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = Left(CC, ДлСС - 1) & Окончание
End If
Else
If Падеж = "р" Then Окончание = "ы"
ElseIf Падеж = "д" Then Окончание = "е"
ElseIf Падеж = "в" Then Окончание = "у"
ElseIf Падеж = "т" Then Окончание = "ой"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = Left(CC, ДлСС - 1) & Окончание
End If
End If
ElseIf ПБ1 = "б" Then
If Падеж = "р" Then Окончание = "а"
ElseIf Падеж = "д" Then Окончание = "у"
ElseIf Падеж = "в" Then Окончание = "а"
ElseIf Падеж = "т" Then Окончание = "ом"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
ElseIf ПБ1 = "в" Then
If (ПБ2 = "а") Or (Фам = 0) Then
If Падеж = "р" Then Окончание = "а"
ElseIf Падеж = "д" Then Окончание = "у"
ElseIf Падеж = "в" Then Окончание = "а"
ElseIf Падеж = "т" Then Окончание = "ом"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
Else
If Падеж = "р" Then Окончание = "а"
ElseIf Падеж = "д" Then Окончание = "у"
ElseIf Падеж = "в" Then Окончание = "а"
ElseIf Падеж = "т" Then Окончание = "ым"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
End If
ElseIf (ПБ1 = "г") Or (ПБ1 = "д") Or (ПБ1 = "ж") Or (ПБ1 = "з") Or (ПБ1 = "к") Or (ПБ1 = "л") Or (ПБ1 = "м") Or (ПБ1 = "н") And (ПБ2 <> "и") And (ПБ2 <> "ы") Or _
(ПБ1 = "п") Or (ПБ1 = "р") Or (ПБ1 = "с") Or (ПБ1 = "т") Or (ПБ1 = "ф") Or (ПБ1 = "х") And (ПБ2 <> "и") And (ПБ2 <> "ы") Or (ПБ1 = "щ") Then
If (Фам = 1) And (Пол = "ж") Then
СклонятьСлово = СС
Exit Function
Else
If Падеж = "р" Then Окончание = "а"
ElseIf Падеж = "д" Then Окончание = "у"
ElseIf Падеж = "в" Then Окончание = "а"
ElseIf Падеж = "т" Then Окончание = "ом"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
End If
ElseIf ПБ1 = "й" Then
If (Фам = 1) And (Пол = "ж") Then
СклонятьСлово = СС
Exit Function
ElseIf (ПБ2 = "и") And (ПБ3 = "к") Then
If Падеж = "р" Then Окончание = "ого"
ElseIf Падеж = "д" Then Окончание = "ому"
ElseIf Падеж = "в" Then Окончание = "ого"
ElseIf Падеж = "т" Then Окончание = "им"
ElseIf Падеж = "п" Then Окончание = "ом"
End If
СС = Left(CC, ДлСС - 2) & Окончание
ElseIf (ПБ2 = "и") And (ПБ3 = "ш") Or (ПБ3 = "щ") Then
If Падеж = "р" Then Окончание = "его"
ElseIf Падеж = "д" Then Окончание = "ему"
ElseIf Падеж = "в" Then Окончание = "его"
ElseIf Падеж = "т" Then Окончание = "им"
ElseIf Падеж = "п" Then Окончание = "ем"
End If
СС = Left(CC, ДлСС - 2) & Окончание
ElseIf (ПБ2 = "о") Or (ПБ2 = "ы") Then
If Падеж = "р" Then Окончание = "ого"
ElseIf Падеж = "д" Then Окончание = "ому"
ElseIf Падеж = "в" Then Окончание = "ого"
ElseIf Падеж = "т" Then Окончание = "ым"
ElseIf Падеж = "п" Then Окончание = "ом"
End If
СС = Left(CC, ДлСС - 2) & Окончание
ElseIf (ПБ2 = "а") Or (ПБ2 = "е") Or (ПБ2 = "и") Or (ПБ2 = "у") Or (ПБ2 = "э") Or (ПБ2 = "ю") Or (ПБ2 = "я") And (ПБ3 <> "к") Then
If Падеж = "р" Then Окончание = "я"
ElseIf Падеж = "д" Then Окончание = "ю"
ElseIf Падеж = "в" Then Окончание = "я"
ElseIf Падеж = "т" Then Окончание = "ем"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = Left(CC, ДлСС - 1) & Окончание
End If
ElseIf (ПБ1 = "н") And ((ПБ2 = "и") Or (ПБ2 = "ы")) Then
If Фам = 1 Then
If Падеж = "р" Then Окончание = "а"
ElseIf Падеж = "д" Then Окончание = "у"
ElseIf Падеж = "в" Then Окончание = "а"
ElseIf Падеж = "т" Then Окончание = "ым"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
Else
If Падеж = "р" Then Окончание = "а"
ElseIf Падеж = "д" Then Окончание = "у"
ElseIf Падеж = "в" Then Окончание = "а"
ElseIf Падеж = "т" Then Окончание = "ом"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
End If
ElseIf (ПБ1 = "х") And ((ПБ2 = "и") Or (ПБ2 = "ы")) Then
СклонятьСлово = СС
Exit Function
ElseIf (ПБ1 = "ц") Or (ПБ1 = "ч") Or (ПБ1 = "ш") Then
If (Фам = 1) And (Пол = "ж") Then
СклонятьСлово = СС
Exit Function
Else
If Падеж = "р" Then Окончание = "а"
ElseIf Падеж = "д" Then Окончание = "у"
ElseIf Падеж = "в" Then Окончание = "а"
ElseIf Падеж = "т" Then Окончание = "ем"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
End If
ElseIf ПБ1 = "ь" Then
If Пол = "м" Then
If Падеж = "р" Then Окончание = "я"
ElseIf Падеж = "д" Then Окончание = "ю"
ElseIf Падеж = "в" Then Окончание = "я"
ElseIf Падеж = "т" Then Окончание = "ем"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = Left(CC, ДлСС - 1) & Окончание
Else
If Фам = 1 Then
СклонятьСлово = СС
Exit Function
Else
If Падеж = "р" Then Окончание = "и"
ElseIf Падеж = "д" Then Окончание = "и"
ElseIf Падеж = "в" Then Окончание = "ь"
ElseIf Падеж = "т" Then Окончание = "ью"
ElseIf Падеж = "п" Then Окончание = "и"
End If
СС = Left(CC, ДлСС - 1) & Окончание
End If
End If
ElseIf ПБ1 = "я" Then
If ПБ2 = "м" Then
If Падеж = "р" Then Окончание = "ени"
ElseIf Падеж = "д" Then Окончание = "ени"
ElseIf Падеж = "в" Then Окончание = "я"
ElseIf Падеж = "т" Then Окончание = "енем"
ElseIf Падеж = "п" Then Окончание = "ени"
End If
СС = Left(CC, ДлСС - 1) & Окончание
ElseIf ПБ2 = "и" Then
If Падеж = "р" Then Окончание = "и"
ElseIf Падеж = "д" Then Окончание = "и"
ElseIf Падеж = "в" Then Окончание = "ю"
ElseIf Падеж = "т" Then Окончание = "ей"
ElseIf Падеж = "п" Then Окончание = "и"
End If
СС = Left(CC, ДлСС - 1) & Окончание
ElseIf ПБ2 = "а" Then
If Падеж = "р" Then Окончание = "ой"
ElseIf Падеж = "д" Then Окончание = "ой"
ElseIf Падеж = "в" Then Окончание = "ую"
ElseIf Падеж = "т" Then Окончание = "ой"
ElseIf Падеж = "п" Then Окончание = "ой"
End If
СС = Left(CC, ДлСС - 1) & Окончание
Else
If Падеж = "р" Then Окончание = "и"
ElseIf Падеж = "д" Then Окончание = "е"
ElseIf Падеж = "в" Then Окончание = "ю"
ElseIf Падеж = "т" Then Окончание = "ей"
ElseIf Падеж = "п" Then Окончание = "е"
End If
СС = CC & Окончание
End If
End If
СклонятьСлово = СС

End Function

слэн

Гость

11.04.2008 21:37:37

длинная, скучная ф-ция :), совсем не по-икселевски..

да и вообще множество всех этих if elseif..
по мне select было бы лучше, а еще лучше - загнать все это в табличку и выбор по нескольким критериям - наиболее частый здесь вопрос :))

vikttur Пользователь Сообщений: 47168 Регистрация: 15.09.2012	#4 11.04.2008 23:40:31 Авось пригодится: склонение ФИО по падежам в EXCEL http://www.delphikingdom.com/asp/viewitem.asp?catalogid=412

krot Пользователь Сообщений: 23 Регистрация: 01.01.1970	#5 12.04.2008 22:13:34 Пасиба за советы....

Guest Гость	#6 19.03.2010 23:08:00 Стал смотреть твою функцию, начал сразу с переименования переменных ;) Оказалось в ней где-то СС - это две русские буквы, а где-то - английские :) Наверно поэтому не работает ...

VovaK Пользователь Сообщений: 1716 Регистрация: 01.01.1970	#7 20.03.2010 09:30:33 Если не секрет, в каких случаях такая функция может пригодиться? Фантазии не хватает.

Юрий М Модератор Сообщений: 60982 Регистрация: 14.09.2012 Контакты см. в профиле	#8 20.03.2010 13:30:12 Зачем такой длиннющий листинг? Выложите любым файлом. Ваш предыдущий пост удаляю.

mishka Гость	#9 20.03.2010 13:56:21 Ок, выкладываю файл, файликом и правда удобнее - в нем все отступы сохраняются :) Спасибо krot-у, кучу времени сэкономил благодаря его листингу :) krot, пиши исчо :) Хотя от твоего первого поста прошло уже 2 года :)) Прикрепленные файлы post_109874.txt (10.05 КБ)

Читают тему