Запросить у пользователя Фамилию Имя Отчество через пробел в одну строку и выдать в сокращенном виде Фамилию И. О. - VBA - Ответ 2240991

Option Compare Text
Public Function Инициалы(s As String, Optional Cлева As Boolean = False)
 
    Dim sv As Variant
    Dim sФ As String
    Dim sИ As String
    Dim sО As String
    Dim i As Long
    Dim k As Long
    Application.Volatile True
    
    If InStr(s, ".") > 0 Or Len(Trim$(s)) = 0 Then
        Инициалы = s 'Инициалы заданы явно или пустая строка
        Exit Function
    End If
    'Нормализация входной строки
    s = Replace(Application.Trim(s), Chr(30), "-")
    s = Replace(Replace(s, " -", "-"), "- ", "-")
    s = Replace(Replace(s, "' ", "'"), " '", "'") ' О 'Генри Александр; О' Генри Александр; Н' Гомо; Д' Тревиль
    sv = Split(s)
    
    sИ = vbNullString
    sО = vbNullString
    sФ = vbNullString
    
    i = UBound(sv)
    If i < 1 Then
        Инициалы = s
        Exit Function
    End If
    Select Case sv(i)
        Case "оглы", "кызы", "заде" 'бей, бек, заде, зуль, ибн, кызы, оглы, оль, паша, уль, хан, шах, эд, эль
            i = i - 1
            sО = UCase(Left$(sv(i), 1)) & "."
            i = i - 1
        Case "паша", "хан", "шах", "шейх"
            i = i - 1
        Case Else
            Select Case Right$(sv(i), 3)
                Case "вич", "вна"
                    If i >= 2 Then 'Стандартное окончание русских отчеств
                        sО = СropWord(sv(i))
                    Else           'Имя типа Босан Славич
                        sИ = СropWord(sv(i))
                        sФ = sv(0)
                    End If
                    i = i - 1
                Case Else
                    k = InStr(sv(i), "-")
                    If k > 0 Then
                        Select Case Mid$(sv(i), k + 1)
                            Case "оглы", "кызы", "заде", "угли", "уулы", "оол" 'Вариант насаба «-оглы» и «-заде»  типа Махмуд-оглы
                                sО = UCase(Left$(sv(i), 1)) & "."
                                i = i - 1
                                If i = 0 Then
                                   sИ = sО
                                   sО = vbNullString
                                End If
                        End Select
                    ElseIf i > 2 Then
                        Select Case sv(i - 1)
                            Case "ибн", "бен", "бин"
                                sО = UCase(Left$(sv(i), 1)) & "." ' Усерталь Алишер бен Сулейман
                                i = i - 2
                        End Select
                    Else ' Бен Эдуард
                        sИ = UCase(Left$(sv(i), 1))
                        If Len(sv(i)) > 1 Then sИ = sИ & "."
                        i = i - 1
                    End If
            End Select
    End Select
         
    Select Case sv(0)
        Case "де", "дел", "дос", "cент", "ван", "фон", "цу"
            If i >= 2 Then
                sФ = sv(0) & " " & StrConv(sv(1), vbProperCase)
                sИ = СropWord(sv(2))
            Else   'Де Николай
                If Len(sИ) > 0 Then
                    sФ = sv(0) & " " & StrConv(sv(1), vbProperCase)
                Else
                    sФ = StrConv(sv(0), vbProperCase)
                    sИ = СropWord(sv(1))
                End If
            End If
       Case Else
            If Len(sФ) = 0 Then 'Ещё не определили фамилию
                sФ = StrConv(sv(0), vbProperCase)
                If Len(sИ) = 0 Then
                   sИ = СropWord(sv(1))
                End If
            End If
    End Select
    If Слева Then
        Инициалы = sИ & sО & " " & sФ
    Else
        Инициалы = sФ & " " & sИ & sО
    End If
 
End Function
Public Function СropWord(s As Variant) As String
    Dim ss As String
    If Len(s) = 1 Then
        СropWord = s
    Else
        ss = UCase(Left$(s, 1)) & "."
        k = InStr(s, "-")
        If k > 0 Then
            ss = ss & "-" & Mid$(s, k + 1, 1) & "."
        End If
        СropWord = ss
    End If
End Function
Function CropFIO(ByVal FIO As String) As String
    ' получает в качестве параметра текстовую строку с виде "Фамилия имя отчество"
    ' обрезает имя и отчество, оставляя лишь инициалы - в виде "Фамилия И. О."
    Application.Volatile True
    CropFIO = Application.Trim(FIO): arr = Split(Replace(CropFIO, "-", " - "), " ")
 
    For i = UBound(arr) - 1 To UBound(arr)
        If Len(arr(i)) > 1 Then arr(i) = UCase(Left(arr(i), 1)) & "."
    Next i
    CropFIO = Replace(Replace(Join(arr, " "), " - ", "-"), ". ", ".")
End Function

Sub tttest()
MsgBox Инициалы("Курамбек сулейман ибн хатаб")
MsgBox CropFIO("Курамбек сулейман ибн хатаб")
End Sub