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


No comments: