Pages


Monday, December 5, 2016

VBA function tách họ, tách tên, tách tên đệm (các function riêng biệt)

Function Tachten(ByVal hovaten As String, Optional nTachten As Boolean = True) As String
Dim pos_right As Integer
If hovaten = vbNullString Then GoTo endfunc:
 
    hovaten = Trim(hovaten)
    pos_right = InStrRev(hovaten, " ")
    If pos_right = 0 Or pos_right - 1 < 0 Or pos_right + 1 > Len(hovaten) Then
        GoTo endfunc:
    End If
    If nTachten Then
        Tachten = Mid(hovaten, pos_right + 1)
    Else
        Tachten = Left(hovaten, pos_right - 1)
    End If
endfunc:

End Function


Function tachho(ByVal hovaten As String, Optional ntachho As Boolean = True) As String
Dim space_left As Integer
If hovaten = vbNullString Then GoTo endfunc:
hovaten = Trim(hovaten)
space_left = InStr(hovaten, " ")
If space_left = 0 Or space_left - 1 < 0 Or space_left + 1 > Len(hovaten) Then GoTo endfunc:
If ntachho Then
    tachho = Left(hovaten, space_left - 1)
Else
    tachho = Mid(hovaten, space_left + 1)
End If
endfunc:

End Function


Function tachdem(ByVal hovaten As String) As String
Dim space_left As Integer
Dim space_right As Integer
If hovaten = vbNullString Then GoTo endfunc:

hovaten = Trim(hovaten)
space_left = InStr(hovaten, " ")
space_right = InStrRev(hovaten, " ")
If space_left = 0 Or space_left - 1 < 0 Or space_left + 1 > Len(hovaten) Or _
    space_right = 0 Or space_right - 1 < 0 Or space_right + 1 > Len(hovaten) Or space_right < space_left + 1 Then
    GoTo endfunc:
End If

tachdem = Mid(hovaten, space_left + 1, space_right - space_left - 1)

endfunc:

End Function

No comments: