Các hàm tách họ tên (1 người xem)

[Vu Dinh Duy]

Chào các bạn,
Mình đang tập làm VBA.
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 Function

 

[Vu Dinh Duy]

Mì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

 

[hungpecc1]

Mì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

Bạn tham khảo link sau , từ đó thử xem code mình thừa thiếu ,hay dở như thế nào nhé !
http://www.giaiphapexcel.com/forum/...ổng-hợp-các-phương-pháp-tách-họ-và-tên

 

[long10]

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
Anh Vũ Dinh Duy có thể giải thích em code này được không ạ

 

[Hoàng Trọng Nghĩa]

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:

[GPECODE=vb]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 Function
[/GPECODE]

Ngay 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ế!)

 

[Hoàng Trọng Nghĩa]

Mì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

Hàm viết tắt họ tên cũng nên tham khảo code này:

Function HoTenTat(ByVal HoTen As String) As String
    HoTen = Trim(HoTen)
    If HoTen = "" Then Exit Function
    Dim SplHoTen, i As Long
    SplHoTen = Split(HoTen, " ")
    For i = 0 To UBound(SplHoTen)
        If SplHoTen(i) > " " Then
            HoTenTat = HoTenTat + Left(SplHoTen(i), 1)
        End If
    Next
End Function

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.

 

[Hoang2013]

Chào các bạn,
Mình đang tập làm VBA.
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é

Nếu đúng là bạn đang tập làm VBA thì mình khuyên bạn cần khai báo các biến thật tường minh & đầy đủ.

Chúc ngày mới tốt lành.

 

[VetMini]

@chủ thớt:

Nếu bạn mới học code thì khi code một hàm, bạn phải đặt vấn đề quan trọng cho tham số.
Theo cách viết hàm của bạn, chuõi đầu vào sẽ bị biến đổi sau khi hàm chạy xong.

Cần tìm đọc thớt "Hướng dẫn truyền tham số trong VBA..." của Phan Tu Huong

@Hoang2013:

Chủ thớt chưa có khái niệm về phạm vi tầm vực của biến. Nên học cái đó trước rồi hãy học cách "khai báo các biến thật tường minh & đầy đủ" - xem giải thích bên trên.

@HTN:

Nếu phải làm một nhóm hàm như thế thì ta có thể chỉ cần hàm tìm từ đầu tiên hoặc từ cuối (tham số 0/1), tìm từ trong chuỗi hay loại từ khỏi chuỗi (tham số 1/-1)

Tên tức là từ cuối trong chuỗi. Họ là từ đầu. Họ và đệm là chuỗi loại đi tên. Đệm là chuỗi loại đi tên, sau đó loại đi họ. VV...

 

[Hoàng Trọng Nghĩa]

@HTN:

Nếu phải làm một nhóm hàm như thế thì ta có thể chỉ cần hàm tìm từ đầu tiên hoặc từ cuối (tham số 0/1), tìm từ trong chuỗi hay loại từ khỏi chuỗi (tham số 1/-1)

Tên tức là từ cuối trong chuỗi. Họ là từ đầu. Họ và đệm là chuỗi loại đi tên. Đệm là chuỗi loại đi tên, sau đó loại đi họ. VV...

Không hiểu ý anh lắm, tôi nghĩ anh đang muốn tôi làm 1 hàm tổng quát, rồi dùng tham số để định kết quả, như 1 là tách tên, 2 là tách họ, 3 là tách tên lót v.v...

Đó cũng là cách hay, nhưng tôi lại thích cách như hàm của Excel, cái nào ra cái đó, như các hàm LOWER, PROPER, UPPER, anh Bill cũng có thể gộp chúng lại với nhau được, nhưng anh í không làm, để tách bạch như thế cho nó dễ hiểu dễ thấy, tường minh qua cái tên hàm.

 

[VetMini]

Có lẽ lúc hàm DATEDIF ra đời, anh Biêu nhà ta đi vắng. Chứ bằng không thì những hàm YEARDIF, MONTHDIF, DAYDIF, ... xài khoẻ ru.

Vấn đề là chiều huớng phân tích và áp dụng thôi.

Ai lại chả biết thiết kế một hàm mà phải IF-ELSE một đống code để đưa ra nhiều trường hợp khác nhau là chơi dại. Thiết kế như thế nào để những yêu cầu có thể dùng chung phần trọng yếu và chỉ IF-ELSE một vài chi tiết nhỏ mới là thử thách của người viết code.

 

[Quang_Hải]

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+)(.*)(\s\S+)"
        TachHoTen = Trim(.Replace(Trim(cell), "$" & Index))
    End With
End Function

 

[VetMini]

Hàm này sẽ bị lỗi nếu Index <> { 1, 2, 3 }
Cần thêm phần bẫy lỗi. Hoặc đẩy ra "#Error" hoặc măc định (Index MOD 3) + 1

=== đính chính ====
Nhầm rồi: nếu măc định (Index MOD 3) + 1 sẽ làm sai trị của Index.
Có lẽ phải dùng IIF(Index > 3, 3, IIF(Index < 1, 1, Index))

 

[Hoàng Trọng Nghĩa]

Có lẽ lúc hàm DATEDIF ra đời, anh Biêu nhà ta đi vắng. Chứ bằng không thì những hàm YEARDIF, MONTHDIF, DAYDIF, ... xài khoẻ ru.

Vấn đề là chiều huớng phân tích và áp dụng thôi.

Ai lại chả biết thiết kế một hàm mà phải IF-ELSE một đống code để đưa ra nhiều trường hợp khác nhau là chơi dại. Thiết kế như thế nào để những yêu cầu có thể dùng chung phần trọng yếu và chỉ IF-ELSE một vài chi tiết nhỏ mới là thử thách của người viết code.

Anh có thấy DATEDIF không? Đã IF thì có nhiều điều kiện, nhưng phải hướng dẫn cụ thể, tỉ mỉ trong Help từng phần của nó, vậy nên sử dụng những dạng hàm này sẽ rất khó chịu; còn hàm chỉ sử dụng 1 loại duy nhất thì đâu cần thiết phải đọc Help nhiều? Chỉ cần nhìn tên là khắc biết nó là hàm cho mục đích gì. Vả lại khi đã sử dụng đến code thì dù một hàm hay nhiều hàm cũng là sử dụng 1 module rồi, vậy thì chép nhiều hàm vào một module cũng "chết thằng tây" nào đâu nè!

 

[VetMini]

Dùng quen rồi thì biết cách phân biệt. Đọc "Help" bị thiếu sót là chuyện thường tình. Hàm ROUND của VBA khác với của WS nhưng có mấy người đọc "Help" đủ để biết đâu?

tb. DATEDIF không chứa từ IF. Nó là DATE + DIF(ference).

 

[Hoàng Trọng Nghĩa]

Dùng quen rồi thì biết cách phân biệt. Đọc "Help" bị thiếu sót là chuyện thường tình. Hàm ROUND của VBA khác với của WS nhưng có mấy người đọc "Help" đủ để biết đâu?

tb. DATEDIF không chứa từ IF. Nó là DATE + DIF(ference).

SUMIF, AVERAGEIF, chẳng phải IF là gì? Nhưng thậm chí hàm DATEDIF này còn không được cập nhật trong HELP nữa là, làm sao xác định được nó là difference chứ?

Mà thôi tùy theo quan điểm của mỗi người vậy.

Riêng hàm của anh Quang Hải mình cải tiến một chút xem sao:

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")
        .Pattern = "(\S+)(.*)(\s\S+)"
        Select Case Index
        Case 1 To 3
            [COLOR=#008000]''Ho: 1, Lot: 2, Ten: 3[/COLOR]
            TachHoTen = Trim(.Replace(HoTen, "$" & Index))
        Case 4
            [COLOR=#008000]''Ho va Lot:[/COLOR]
            TachHoTen = .Replace(HoTen, "$3")
            TachHoTen = Replace(HoTen, TachHoTen, "")
        Case Else
            [COLOR=#008000]''Xu ly loi:[/COLOR]
[COLOR=#0000ff]            TachHoTen = CVErr(xlErrNA)[/COLOR]
        End Select
    End With
End Function

Thật tình mình cũng không thích cái "vbscript.regexp" này cho lắm vì nó có cấu trúc khó nhớ quá!

 

[Quang_Hải]

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+)(.*)(\s\S+)"
        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+)(.*)(\s\S+)"
        Ho = Trim(.Replace(Trim(cell), "$1"))
    End With
End Function

Function Lot(cell As Range) As String
    With CreateObject("vbscript.regexp")
        .Pattern = "(\S+)(.*)(\s\S+)"
        Lot = Trim(.Replace(Trim(cell), "$2"))
    End With
End Function

Function Ten(cell As Range) As String
    With CreateObject("vbscript.regexp")
        .Pattern = "(\S+)(.*)(\s\S+)"
        Ten = Trim(.Replace(Trim(cell), "$3"))
    End With
End Function

 

[VetMini]

Không ai tách code cùng một dạng ra nhiều nơi cả. Nếu bạn muốn nhiều hàm thì dùng 1 hàm tổng quát (private để giấu nó đi) và các hàm kia gọi nó với đúng tham số. Đó là ý của tôi từ đầu.

 

[Hoàng Trọng Nghĩa]

Riêng hàm của anh Quang Hải mình cải tiến một chút xem sao:

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")
        .Pattern = "(\S+)(.*)(\s\S+)"
        Select Case Index
        Case 1 To 3
            [COLOR=#008000]''Ho: 1, Lot: 2, Ten: 3[/COLOR]
            TachHoTen = Trim(.Replace(HoTen, "$" & Index))
        [COLOR=#ff0000][B]Case 4[/B][/COLOR]
            [COLOR=#008000]''Ho va Lot:[/COLOR]
            TachHoTen = .Replace(HoTen, "$3")
            [COLOR=#ff0000][B]TachHoTen = Replace(HoTen, TachHoTen, "")[/B][/COLOR]
        Case Else
            [COLOR=#008000]''Xu ly loi:[/COLOR]
[COLOR=#0000ff]            TachHoTen = CVErr(xlErrNA)[/COLOR]
        End Select
    End With
End Function

Hàm trên vẫn chưa được ở Index = 4, nếu dùng REPLACE, bởi nếu tên và họ hay lót trùng nhau thì vô hình chung chúng sẽ loại bỏ hết, cho nên phải:

Thay vì:

TachHoTen = Replace(HoTen, TachHoTen, "")

Thì nên:

TachHoTen = Left(HoTen, Len(HoTen) - Len(TachHoTen))

Còn không biết cách mà anh Quang Hải làm cho trường hợp 4 này như thế nào vì không rành lắm về Reg.

 

[Quang_Hải]

Hàm trên vẫn chưa được ở Index = 4, nếu dùng REPLACE, bởi nếu tên và họ hay lót trùng nhau thì vô hình chung chúng sẽ loại bỏ hết, cho nên phải:

Thay vì:

TachHoTen = Replace(HoTen, TachHoTen, "")

Thì nên:

TachHoTen = Left(HoTen, Len(HoTen) - Len(TachHoTen))

Còn không biết cách mà anh Quang Hải làm cho trường hợp 4 này như thế nào vì không rành lắm về Reg.

Viết theo cách của anh Nghĩa

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+)(.*)(\s\S+)"
            TachHoTen = Trim(.Replace(HoTen, "$" & Index))
        Case 4
            ''Ho va Lot:
            .Pattern = "(.*)(\s\S+)"
            TachHoTen = Trim(.Replace(Trim(HoTen), "$" & Index - 3))
        Case Else
            ''Xu ly loi:
            TachHoTen = CVErr(xlErrNA)
        End Select
    End With
End Function

 

[Thuyanhanoi]

Viết theo cách của anh Nghĩa

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+)(.*)(\s\S+)"
            TachHoTen = Trim(.Replace(HoTen, "$" & Index))
        Case 4
            ''Ho va Lot:
            .Pattern = "(.*)(\s\S+)"
            TachHoTen = Trim(.Replace(Trim(HoTen), "$" & Index - 3))
        Case Else
            ''Xu ly loi:
            TachHoTen = CVErr(xlErrNA)
        End Select
    End With
End Function

- Xem chủ đề này em thấy cũng giống với yêu cầu lấy 1 địa danh trong file đính kèm của em. Trong file em có sử dụng công thức để lấy địa danh cuối

=TRIM(RIGHT(SUBSTITUTE(M6,"-",REPT(" ",LEN(M6))),LEN(M6)))

. Nhưng sử dụng hàm VBA thì chưa rành lắm.
- Các anh viết hàm cho em được mở rộng kiến thức với. Cảm ơn các Anh nhiều....

 

[Hoàng Trọng Nghĩa]

Viết theo cách của anh Nghĩa

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+)(.*)(\s\S+)"
            TachHoTen = Trim(.Replace(HoTen, "$" & Index))
        Case 4
            ''Ho va Lot:
            .Pattern = "(.*)(\s\S+)"
            [COLOR=#ff0000][B]TachHoTen = Trim(.Replace(Trim(HoTen), "$" & Index - 3))[/B][/COLOR]
        Case Else
            ''Xu ly loi:
            TachHoTen = CVErr(xlErrNA)
        End Select
    End With
End Function

Cái dòng màu đỏ anh Hải cũng hơi máy móc, chỉ cần vầy là được rôi phải không:

TachHoTen = .Replace(HoTen, "$1")

Nhưng quả thực là anh rành về Reg thiệt!

 

[Quang_Hải]

SUMIF, AVERAGEIF, chẳng phải IF là gì? Nhưng thậm chí hàm DATEDIF này còn không được cập nhật trong HELP nữa là, làm sao xác định được nó là difference chứ?

Mà thôi tùy theo quan điểm của mỗi người vậy.

Mình nghĩ là với việc viết code cho vui thì chỉ cần thể hiện thuật toán. Những chuyện khác không quan trọng đối với mình. Dated If hay Date Dif cũng chẳng sao mà. Nhưng có lẽ là Date Difference đấy nhá. Cảm giác thôi vì mình biết chút tiếng Anh.

Sam chút thôi. Lúc nào thuận tiện thì MOD dọn dẹp bài này cho gọn topic.

 

[VetMini]

1. Muốn lây họ + lót thì dùng replace khác:

.Pattern = "\s\S+$" ' match là tên
HVL = Trim(.Replace(Trim(cell), "")) ' replace bằng "" -> còn lại họ + lót

.Pattern = "^\S+" ' match là họ
LVT = Trim(.Replace(Trim(cell), "")) ' replace bằng "" -> còn lại lót + tên

2. Sử dụng nhiều hàm:

Private Function TachHoTen(cell As Range, Optional ByVal Index As Long = 3) As String
...

Function Ho(cell As Range) As String
Ho = TachHoTen(cell, 1)
End Function

Function Lot(cell As Range) As String
Lot = TachHoTen(cell, 2)
' Lưu ý là hàm này cần phải thêm code ở đây mới hoàn chỉnh
End Function

Function Ten(cell As Range) As String
Ten = TachHoTen(cell, 3)
' Lưu ý là riêng hàm này cần phải thêm code ở đây mới hoàn chỉnh
End Function

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).