Pages


Monday, December 5, 2016

VBA Function Tách họ và tên (ver 2)

Function Tachhoten(ByVal hovaten As String, n As String, Optional stachten As Boolean = True) As String
Dim space_left As Integer
Dim space_right As Integer
'neu du lieu nhap vao la trong thi khong lam gi
If hovaten = vbNullString Then GoTo endfunc:
hovaten = Trim(hovaten)                     'Loai bo cac khoang trang vo nghia
space_left = InStr(hovaten, " ")            'Lay gia tri khoang trang dau tien tu ben trai
space_right = InStrRev(hovaten, " ")        'Lay gia tri khoang trang dau tien tu ben phai

'Neu cac khoang trang o dau hoac cuoi thi khong lam gi
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) Then GoTo endfunc:

Select Case n                               'Duyet qua cac gia tri de xac dinh tac dung cua ham
Case "ho"                                   'Neu muc dich la tach lay "ho"
    If stachten Then                        'Neu chi muon lay ho
        Tachhoten = Left(hovaten, space_left - 1)
    Else                                    'Neu muon lay ca ho va ten dem
        Tachhoten = Left(hovaten, space_right - 1)
    End If
   
Case "dem"
    If space_right < space_left + 1 Then GoTo endfunc:
   
    Tachhoten = Mid(hovaten, space_left + 1, space_right - space_left - 1)
   
Case "ten"                                  'Neu muc dich la tach lay "ten"
    If stachten Then                        'Neu chi muon lay ten
        Tachhoten = Mid(hovaten, space_right + 1)
    Else                                    'Neu muon lay ca ten dem va ten
        Tachhoten = Mid(hovaten, space_left + 1)
    End If
   
Case Else                                   'Neu gia tri nhap vao khong phai la "ho", "ten", "dem" thi bao loi
    MsgBox ("Chi nhap vao cac gia tri 'ho', 'dem', 'ten'." & vbNewLine & "Hay nhap lai du lieu")
    GoTo endfunc:
       
End Select

endfunc:

End Function


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

VBA function Tách họ và tên (ver 1)

Function Tachhoten(ByVal hovaten As String, n 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) Then GoTo endfunc:

Select Case n
Case "ho"
    Tachhoten = Left(hovaten, space_left - 1)
Case "dem"
    If space_right < space_left + 1 Then GoTo endfunc:
 
    Tachhoten = Mid(hovaten, space_left + 1, space_right - space_left - 1)
 
Case "ten"
    Tachhoten = Mid(hovaten, space_right + 1)
Case Else
    MsgBox ("Chi nhap vao cac gia tri 'ho', 'dem', 'ten'." & vbNewLine & "Hay nhap lai du lieu")
    GoTo endfunc:
     
End Select

endfunc:

End Function