TopPicLogo TopPicText

Деление строки на слова (например - деление полного имени на части)

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

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(val As Variant, intPosition As Integer, _
            Optional strSeparator As String = " ") As Variant
Dim v As Integer
Dim i As Integer, x As Integer
'es 29.01.04
'Рубит строку переданную в аргументе: val на отдельные слова
'   и возвращает слово стоящее в позиции указанной в intPosition
'   ... или Null если в заданной позиции слова нет
'Аргумент: strSeparator = разделитель слов (по умолчанию=пробел " ")
'----------------------------------------------------------------
On Error GoTo cutStrErr
    val = val & strSeparator
    x = 1
    For i = 1 To intPosition
        v = InStr(x, val, strSeparator)
        If v = 0 Then cutStr = Null: Exit For
        If i = intPosition Then
            cutStr = Mid(val, 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 cutStrSplit(val As Variant, intPosition As Integer, _
            Optional strSeparator As String = " ") As Variant
Dim v() As String
'----------------------------------------------------------------
On Error GoTo cutStrSplitErr
    If IsNull(val) Then cutStrSplit = Null: Exit Function
    v = Split(val, strSeparator, intPosition)
    cutStrSplit = v(intPosition - 1)
'На случай лишних пробелов
    cutStrSplit = Trim(cutStrSplit)
    If cutStrSplit = "" Then cutStrSplit = Null
    Exit Function
cutStrSplitErr:
    cutStrSplit = "#Error!#"
    Err.clear
End Function

Назад ToTop
L.E. 12.11.2012
Рейтинг@Mail.ru