Разделение строки на части, например полного имени на ФИО отдельно

Пример использования:

Private Sub test()
Dim str As String
Dim v As Variant
    
    str = "Сидоров Петр Иванович"
    v = "Пример работы функции cutStr():"
    v = v & vbCrLf & String(30, "-")
    v = v & vbCrLf & "Часть 2 = " & cutStr(str, 2)
    v = v & vbCrLf & "Часть 3 = " & cutStr(str, 3)
    v = v & vbCrLf & "Часть 8 = "
    If IsNull(cutStr(str, 8)) Then v = v & "Null" Else v = v & " ...  "
    Debug.Print v

End Sub

Напишет:

Пример работы функции cutStr():
------------------------------
Часть 2 = Петр
Часть 3 = Иванович
Часть 8 = Null

Собственно функция:

Public Function cutStr(vVal As Variant, intPosition As Integer, _
            Optional strSeparator As String = " ") As Variant
'es 29.01.2004 LE 30.07.2021 v002
'Рубит строку переданную в аргументе: vVal на отдельные слова
'   и возвращает слово стоящее в позиции указанной в intPosition
'   ... или Null если в заданной позиции слова нет
'Аргумент: strSeparator = разделитель слов (по умолчанию = пробел " ")
'----------------------------------------------------------------
Dim v As Integer
Dim i As Integer, x As Integer

On Error GoTo cutStrErr
    vVal = vVal & strSeparator
    x = 1
    For i = 1 To intPosition
        v = InStr(x, vVal, strSeparator)
        If v = 0 Then cutStr = Null: Exit For
        If i = intPosition Then
            cutStr = Trim(Mid(vVal, x, v - x))
            Exit For
        Else
            x = CInt(v + 1)
        End If
    Next i
'На случай лишних пробелов
    cutStr = Trim(cutStr)
    If cutStr = "" Then cutStr = Null
    Exit Function
cutStrErr:
    cutStr = "#Error!#"
    Err.Clear
End Function

Второй вариант того же самого но с использованием функции Split()
- работает примерно на 20% медленнее

Public Function PartOfFullName(vString As Variant, iPosition As Integer, _
        Optional sSeparator As String = " ") As Variant
'es 25.09.2020 v002
' Рубит переданную в аргументе строку ФИО на отдельные:
' Фамилию, Имя и Отчество.
' Возвращает слово стоящее в позиции указанной в iPosition
'----------------------------------------------------------------
'Аргументы:
'   vString    = Исходная строка (ФИО полностью или частично)
'   iPosition  = Вовращаемая позция слова в строке
'   sSeparator = Разделитель слов (по умолчанию = пробел " ")
'----------------------------------------------------------------
'   QBE: PartOfFullName([TestSourseFIO];1)
'----------------------------------------------------------------

Dim sArr() As String, sTemp$, i%, x%
'----------------------------------------------------------------
On Error GoTo PartOfFullName_Err
'Обслуживание лишних пробелов вокруг тире "-"
    If InStr(vString, "-") > 0 Then
        vString = Replace(vString, " - ", "-")
        vString = Replace(vString, "- ", "-")
        vString = Replace(vString, " -", "-")
    End If
    vString = Replace(vString, "  ", " ") 'Двойные пробелы на одинарные
'Части в массив:
    sArr = Split(vString, sSeparator)
    x = UBound(sArr)                      'Нижняя граница массива
    sTemp = sArr(iPosition - 1)

'Только для имён! - Остальные части (если есть) загоняем в отчество:
    If iPosition = 3 Then
        For i = 3 To x
            sTemp = sTemp & " " & sArr(i)
        Next i
    End If
    PartOfFullName = sTemp

PartOfFullName_End:
    Exit Function

PartOfFullName_Err:
    Err.Clear
    Resume PartOfFullName_End
End Function

Третий вариант того же

Public Function CutString(sString$, iPartNo As Integer) As Variant
'es - 23.06.2019
'----------------------------------------------------------------
'Разделение строки
'Например: Петрова Ирина Ваильевна на ФИО раздельно
'----------------------------------------------------------------
Dim s$, i%, iDateStart%
Dim vArr As Variant
On Error GoTo CutString_Error
    
  
    s = sString
    vArr = Split(s, " ") 'Разделитель
    CutString = vArr(iPartNo - 1)

CutString_End:
    On Error GoTo 0
    Exit Function

CutString_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CutString, line " & Erl & "."
    Err.Clear
    Resume CutString_End
End Function