MyTetra Share
Делитесь знаниями!
Деление строки на части (например - деление полного имени на части)
19.07.2018
19:35
Раздел: VBA - Access - msa.polarcom.ru - 13 Преобразование Строк


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

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

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




Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования