Public Sub PossessiveCase()

'Склоняем ФИО в родительный падеж
Dim strName1 As String, strName2 As String, strName3 As String
For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Dim fname$(): fname = Split(Cells(I, 1))
strName1 = fname(0) ' фамилия
strName2 = fname(1) ' имя
strName3 = fname(2) ' отчество
' Если в ячейке менее трех слов
If strName1 = "" Or strName2 = "" Or strName3 = "" Then
'Не Склоняем
Else
'Склоняем
Cells(I, 2) = dhPossessive(strName1, strName2, strName3)
End If
Next
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 "о", "и", "я", "а"
dhPossessive = 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