Các hàm tách họ tên
Mình gửi lên diễn đàn Code của một số hàm tự tạo: Tách họ, chữ lót và tên ra khỏi tên.
Các hàm này sẽ giúp các bạn tách "Họ", "Chữ lót", "Họ và chữ lót", "Tên" ra khỏi "Họ tên".
Các hàm này còn có thể bỏ các khoảng trống dư trong "Họ tên".
Các bạn tham khảo thêm file đính kèm nhé
Cảm ơn các bạn._______________________________ Function tachho(i As String) As String i = Trim(i) Do While Left(i, 1) <> " " tachho = tachho & Left(i, 1) i = Right(i, Len(i) - 1) Loop End Function __________________________________ Function Tachchulot(j As String) As String j = Trim(j) Do While Right(j, 1) <> " " j = Left(j, Len(j) - 1) Loop Do While Left(j, 1) <> " " j = Right(j, Len(j) - 1) Loop j = Trim(j) Tachchulot = j End Function _______________________________________ Function Tachhovachulot(k As String) As String k = Trim(k) Do While Right(k, 1) <> " " k = Left(k, Len(k) - 1) Loop k = Trim(k) Tachhovachulot = k End Function _______________________________ Function tachten(l As String) As String l = Trim(l) Do While Right(l, 1) <> " " tachten = Right(l, 1) & tachten l = Left(l, Len(l) - 1) Loop End FunctionMình thấy có bạn hỏi về lấy các ký tự đầu của một chuỗi ký tự.
Mình cũng viết Code thử. Các bạn tham khảo nhé.Function laykytudau(i As String) As String
Dim k As String, j As Double
k = Left(i, 1)
For j = 2 To Len(i)
If Mid(i, j, 1) = " " Then
k = k & Mid(i, j + 1, 1)
End If
Next j
laykytudau = k
End Function
Với các hàm loại này, chỉ làm đơn giản như vầy thôi, không cần phải Do … Loop:
Function TachHo(ByVal HoTen As String) As String
HoTen = Trim(HoTen)
If HoTen = "" Then Exit Function
Dim SplHoTen
SplHoTen = Split(HoTen, " ")
TachHo = SplHoTen(0)
End Function
Function TachTen(ByVal HoTen As String) As String
HoTen = Trim(HoTen)
If HoTen = "" Then Exit Function
Dim SplHoTen
SplHoTen = Split(HoTen, " ")
TachTen = SplHoTen(UBound(SplHoTen))
End Function
Function TachTenLot(ByVal HoTen As String) As String
HoTen = WorksheetFunction.Trim(HoTen)
If HoTen = "" Then Exit Function
Dim SplHoTen, u As Long
SplHoTen = Split(HoTen, " ")
u = UBound(SplHoTen) - 1
If u > 0 Then
ReDim Preserve SplHoTen(0 To u)
TachTenLot = Join(SplHoTen, " ")
TachTenLot = Mid(TachTenLot, InStr(TachTenLot, " ") + 1)
End If
End Function
Function TachHoTenLot(ByVal HoTen As String) As String
HoTen = WorksheetFunction.Trim(HoTen)
If HoTen = "" Then Exit Function
Dim SplHoTen, u As Long
SplHoTen = Split(HoTen, " ")
u = UBound(SplHoTen) - 1
If u = -1 Then
TachHoTenLot = HoTen
Else
ReDim Preserve SplHoTen(0 To u)
TachHoTenLot = Join(SplHoTen, " ")
End If
End FunctionNgay các hàm của bạn, giả sử rằng nếu ai đó "lai căng" đặt tên cho con chỉ một chữ (Jenni, Tom, Chanel v.v…) thì sẽ bị lỗi đấy! (nhưng hy vọng không ai đặt như thế!)
Khóa học Power PI – Ứng dung trong Nhân sự
TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...
Xem khóa học
Hàm viết tắt họ tên cũng nên tham khảo code này:
Riêng hàm bạn cần xử lý các khoảng trắng dư thừa nếu ai đó gõ cách khoảng hơn 1 lần.
Tham khảo thêm hàm 3 trong 1 này
Function TachHoTen(cell As Range, Optional ByVal Index As Long = 3) As String
'Get Surname or MiddleName or Firstname
With CreateObject("vbscript.regexp")
.Pattern = "(S+)(.*)(sS+)"
TachHoTen = Trim(.Replace(Trim(cell), "$" & Index))
End With
End Function
Nhân tiện tách ra từng hàm cho các bạn mới học VBA tham khảo cách dùng Reg
Function Ho(cell As Range) As String
With CreateObject("vbscript.regexp")
.Pattern = "(S+)(.*)(sS+)"
Ho = Trim(.Replace(Trim(cell), "$1"))
End With
End Function
Function Lot(cell As Range) As String
With CreateObject("vbscript.regexp")
.Pattern = "(S+)(.*)(sS+)"
Lot = Trim(.Replace(Trim(cell), "$2"))
End With
End Function
Function Ten(cell As Range) As String
With CreateObject("vbscript.regexp")
.Pattern = "(S+)(.*)(sS+)"
Ten = Trim(.Replace(Trim(cell), "$3"))
End With
End Function
Viết theo cách khác:
Function TachHoTen(ByVal HoTen As String, Optional ByVal Index As Long = 3)
HoTen = WorksheetFunction.Trim(HoTen)
If HoTen = "" Then Exit Function
With CreateObject("vbscript.regexp")
Select Case Index
Case 1 To 3
''Ho: 1, Lot: 2, Ten: 3
.Pattern = "(S+)(.*)(sS+)"
TachHoTen = Trim(.Replace(HoTen, "$" & Index))
Case 4
''Ho va Lot:
.Pattern = "(.*)(sS+)"
TachHoTen = Trim(.Replace(Trim(HoTen), "$" & Index – 3))
Case Else
''Xu ly loi:
TachHoTen = CVErr(xlErrNA)
End Select
End With
End Function
1. Muốn lây họ + lót thì dùng replace khác:
2. Sử dụng nhiều hàm:
Lưu ý trong Hàm Lot và Ten:
Vì cái pattern trong hàm chính sẽ hỏng nếu chuỗi chỉ có 1 từ (vd "Nguyen"). Cho nên phương thức Replace của Regex sẽ không làm gì cả. Và vì vậy hàm sẽ trả về nguyên chuỗi ban đầu. Đối với họ thì được, vì 1 từ tức là họ. Nhưng với lót và tên thì cần thêm phần so sánh kết quả lấy về với chuỗi ban đầu, nếu chúng giống nhau là xoá đi (tức là chuỗi không có lót-tên)
3. Có cách khác là thay vì dùng phương thức Replace thì dùng hàm Execute; nếu count > 0 thì lấy cái Object đầu tiên (chỉ số 0); các Submatches của Object này là họ (0), lót (1), tên (2).