Не получается учесть фамилии-исключения в функции ReplaceSurname. Должна быть в цикле женской фамилии в начале проверка на исключение, а затем уже склонение. Но там где надо поставить  исключение выводится пробел.


Function DativeCase(sSurname$, Optional sName$, Optional sPatronymic$) As String
   ' Функция формирует дательный падеж из ФИО
   ' Параметры: sSurname - фамилия, sName - имя, sPatronymic - отчество
   ' © 2013 EducatedFool

   Application.Volatile True    ' автопересчёт формулы на листе
   sSurname$ = Replace(sSurname$, " - ", "-"): sSurname$ = Replace(Replace(sSurname$, " -", "-"), "- ", "-")

   On Error Resume Next
   If sName$ = "" And sPatronymic$ = "" Then
       arr = Split(Application.Trim(sSurname$))
       sSurname$ = arr(0): sName$ = arr(1): sPatronymic$ = Replace(arr(2), ".", "")
   End If

   ' пол теперь определяется иначе:   что заканчивается на "вна" или "кызы" - то женщины, остальные - мужчины.
   Dim bMaleSex As Boolean:    ' bMaleSex = (Right(sPatronymic, 1) = "ч" Or Right(sPatronymic, 4) = "оглы")
   bMaleSex = Not (Right(sPatronymic, 2) = "на" Or Right(sPatronymic, 4) = "кызы")

   If Len(sSurname) > 0 Then    '   Фамилия
       arrSurname = Split(sSurname, "-")
       For i = LBound(arrSurname) To UBound(arrSurname)    ' перебираем все части фамилий, содержащих дефис
           sRes = "": sSurnamePart = arrSurname(i)

           If bMaleSex Then    ' мужские фамилии
               Select Case Right(sSurnamePart, 1)
                   Case ****: sRes = sSurnamePart
                   Case ****: sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ю"
                   Case ***: sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "е"
                       If UBound(arrSurname) > 0 And i = 0 Then sRes = sSurnamePart
                   Case Else: sRes = sSurnamePart & "у"
               End Select              

          Else    ' женские фамилии
                SurException$ = ReplaceSurname(sSurnamePart)
                If Len(SurException$) Then    ' для фамилий-исключений
                   DativeCase = DativeCase & SurException$
                Else  ' фамилия не найдена в списке исключений
                  Select Case Right(sSurnamePart, 1)
                       Case "*****: sRes = sSurnamePart
                       Case ***: sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 2) & "ой"
                       Case Else: sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "ой"
                   End Select

                   Select Case Right(sSurnamePart, 2)    ' добавлено, для редких фамилий
                       Case "ха", "ла", "ее": sRes = Mid(sSurnamePart, 1, Len(sSurnamePart) - 1) & "е"
                   End Select
               End If
           End If

         
           If LCase(sSurnamePart) Like "*[уеыаоэяиюё]а" Then sRes = sSurnamePart

           arrSurname(i) = sRes
       Next
       DativeCase = Join(arrSurname, "-") & " "    ' соединяем части склоняемой фамилии обратно в одну строку
   End If

   If Len(sName) > 0 Then    '   Имя
       NameException$ = GetDativeException(sName)
       If Len(NameException$) Then    ' для имен-исключений
           DativeCase = DativeCase & NameException$
       Else    ' имя не найдено в списке исключений
           If bMaleSex Then
               Select Case Right(sName, 1)
                   Case "й", "ь": DativeCase = DativeCase & Mid(sName, 1, Len(sName) - 1) & "ю"
                   Case "я", "а": DativeCase = DativeCase & Mid(sName, 1, Len(sName) - 1) & "е"
                   Case "о": DativeCase = DativeCase & sName
                   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
       End If
       DativeCase = DativeCase & " "
   End If

   If Len(sPatronymic) > 0 Then    '   Отчество
       If Right(sPatronymic, 4) = "оглы" Or Right(sPatronymic, 4) = "кызы" Then
           DativeCase = DativeCase & sPatronymic
       Else
           If bMaleSex Then
               DativeCase = DativeCase & sPatronymic & "у"
           Else
               DativeCase = DativeCase & Mid(sPatronymic, 1, Len(sPatronymic) - 1) & "е"
           End If
       End If
   End If
   DativeCase = Replace(DativeCase, "-", "- ")
   DativeCase = StrConv(DativeCase, vbProperCase)
   DativeCase = Replace(DativeCase, "- ", "-")
End Function

Function GetDativeException(ByVal txt$) As String    ' склонение имён-исключений
   Select Case txt$
       Case "Павел": GetDativeException = "Павлу"
       Case "Лев": GetDativeException = "Льву"
       Case "Пётр": GetDativeException = "Петру"
       Case "Бибугуль": GetDativeException = "Бибигули"
       Case "Гузель": GetDativeException = "Гузели"
       Case "Анаргуль": GetDativeException = "Анаргули"
       Case "Алия": GetDativeException = "Алии"
       Case "Галия": GetDativeException = "Галии"
       Case "Альфия": GetDativeException = "Альфии"
           
           ' без изменения (не склоняются) - перечисляем через запятую
       Case "Али", "Бали": GetDativeException = txt$
   End Select
End Function

Function ReplaceSurname(ByVal surname As String) As String
   Select Case surname
       Case "Дербнавы": ReplaceSurname = "Дербнавывпфв" ' пример исключения
       ' Добавьте другие исключения здесь
       Case Else: ReplaceSurname = "" ' возвращает оригинальную фамилию, если она не найдена в списке исключений
   End Select
End Function