Xin hàm chuyển đổi họ tên theo chuẩn

[chibi]

Các bạn cho mình xin hàm có chức năng như sau: Chuyển chuỗi họ tên về chuỗi chuẩn, cụ thể: Cắt các khoảng trắng lớn hơn 1 ở giữa, trong mỗi tiếng viết hoa kí tự đầu và viết thường các kí tự sau. (Dùng font TCVN3)

 

[phamduylong]

Các bạn cho mình xin hàm có chức năng như sau: Chuyển chuỗi họ tên về chuỗi chuẩn, cụ thể: Cắt các khoảng trắng lớn hơn 1 ở giữa, trong mỗi tiếng viết hoa kí tự đầu và viết thường các kí tự sau. (Dùng font TCVN3)

Đây là hàm chuyển họ tên thành họ tên chuẩn (chữ hoa đầu từ và cắt các khoảng trắng thừa) bảng mã TCVN3
Chú ý phải chép các hằng vn3, vn3h, vn3t chung với Function HotenVN3

Const [COLOR=blue]vn3[/COLOR] = " ­¨¨¸«»×÷©¬®µ¶·¼½¾¹ªáâäãåæÆçÇçÐéÉÈèÊêëËíÌìÎîÏïÑñÓóÒòòÔôöÖÕõØøßþÞþúùûÜÜüÝý¦¡¡¸¤»×÷¢¥§µ¶·¼½¾¹£áâäãåæÆçÇçÐéÉÈèÊêëËíÌìÎîÏïÑñÓóÒòòÔôöÖÕõØøßþÞþúùûÜÜüÝý"

Const [COLOR=blue]vn3h[/COLOR] = " ¦¡¡¸¤»×÷¢¥§µ¶·¼½¾¹£áâäãåæÆçÇçÐéÉÈèÊêëËíÌìÎîÏïÑñÓóÒòòÔôöÖÕõØøßþÞþúùûÜÜüÝý¦¡¡¸¤»×÷¢¥§µ¶·¼½¾¹£áâäãåæÆçÇçÐéÉÈèÊêëËíÌìÎîÏïÑñÓóÒòòÔôöÖÕõØøßþÞþúùûÜÜüÝý"

Const [COLOR=blue]vn3t[/COLOR] = " ­¨¨¸«»×÷©¬®µ¶·¼½¾¹ªáâäãåæÆçÇçÐéÉÈèÊêëËíÌìÎîÏïÑñÓóÒòòÔôöÖÕõØøßþÞþúùûÜÜüÝý­¨¨¸«»×÷©¬®µ¶·¼½¾¹ªáâäãåæÆçÇçÐéÉÈèÊêëËíÌìÎîÏïÑñÓóÒòòÔôöÖÕõØøßþÞþúùûÜÜüÝý"

Function HotenVN3(hoten As String) As String
Dim tenmoi As String
If Trim(hoten) = "" Then Exit Function
hoten = " " & Application.WorksheetFunction.Trim(hoten)
For i = 2 To Len(hoten)
  kytu = Mid(hoten, i, 1)
  vt = InStr(1, vn3, kytu)
  If vt = 0 Then
    If Mid(hoten, i - 1, 1) = " " Then
      tenmoi = tenmoi & UCase(kytu)
    Else
      tenmoi = tenmoi & LCase(kytu)
    End If
  Else
    If Mid(hoten, i - 1, 1) = " " Then
      tenmoi = tenmoi & Mid(vn3h, vt, 1)
    Else
      tenmoi = tenmoi & Mid(vn3t, vt, 1)
    End If
  End If
Next
HotenVN3 = tenmoi
End Function

 

[anhtuan1066]

Thầy Long cho hỏi:
Tại sao ko là:hoten = " " & Trim(hoten)
mà lại phải là:hoten = " " & Application.WorksheetFunction.Trim(hoten)
???
ANH TUẤN

 

[SA_DQ]

Thầy Long cho hỏi: Tại sao ko là:hoten = " " & Trim(hoten)
mà lại phải là:hoten = " " & Application.WorksheetFunction.Trim(hoten)
??? ANH TUẤN

Tranh thủ lúc Thầy Long bận việc nước, việc nhà:
Trong VBA cũng có hàm Trim(), LTrim() & RTrim() ; Tại VBA thì nên dùng của VBA (!)
Nhập za tùy tục, phải không AnhTuan1066!

Chúc cháu con Vua Hùng luôn mạnh khỏe & hạnh phúc!

 

[khongbietso]

Có cách nào để cho họ tên mà nguyên âm có dấu vẫn hoa lên đc không vd phạm xuân ẩn, tôi nghĩ là không thể làm đc với trường hợp này vì phải chọn font .vnxxxxH cho ký tự đó mới được.

 

[phamduylong]

Thầy Long cho hỏi:
Tại sao ko là:hoten = " " & Trim(hoten)
mà lại phải là:hoten = " " & Application.WorksheetFunction.Trim(hoten)
???
ANH TUẤN

Trim(hoten) dùng Trim của VBA. Nó chỉ cắt khoảng trắng trước, sau của chuỗi. Vd " aaa bbb" > "aaa bb"
Application.WorksheetFunction.Trim(hoten) dùng Trim của Excel. Nó chỉ cắt khoảng trắng trước, sau của chuỗi và khoảng trắng dư trong chuỗi. Vd " aaa bb" > "aaa bb"

 

[phamduylong]

Có cách nào để cho họ tên mà nguyên âm có dấu vẫn hoa lên đc không vd phạm xuân ẩn, tôi nghĩ là không thể làm đc với trường hợp này vì phải chọn font .vnxxxxH cho ký tự đó mới được.

nguyên âm thường có dấu của TCVN3 (và một số font 1 byte khác) không thể chuyển sang nguyên âm hoa có dấu. Muốn phạm xuân ẩn > Phạm Xuân Ẩn thì phải định dạng riêng cho ký tự Ẩ. font .vnxxxxH.
Tôi cũng đã chú ý đến vấn đề này và đã có viết 1 chương trình để xử lý chuỗi cho Excel gồm : chuyển bảng mã, sắp xếp, chuyển câu, tách ghép họ tên, ...
Riêng Chuyển câu font TCVN3 từ chữ thường sang chữ hoa sẽ định dạng đúng font .vnxxxx hoặc .vnxxxxH nên hiển thị đúng Phạm Xuân Ẩn.
Viết chưa hoàn chỉnh nhưng thấy các bạn có nhu cầu nên gởi lên. Các bạn nên lưu dữ liệu trước khi chạy chương trình.

 

[ongtrungducmx25]

chào thầy Long em thấy file này của pác hay lắm nhưng không thể nào xem được code, trong đó có lịch bằng UF em muốn xem thử

 

[boyxin]

Các bạn cho mình xin hàm có chức năng như sau: Chuyển chuỗi họ tên về chuỗi chuẩn, cụ thể: Cắt các khoảng trắng lớn hơn 1 ở giữa, trong mỗi tiếng viết hoa kí tự đầu và viết thường các kí tự sau. (Dùng font TCVN3)

Hàm cực chuẩn dùng cho Font TCVN3

Function Ustr(S)
Dim Sb, Db, k, x As String
Dim i  As Integer, n As Integer
S = " " & Application.WorksheetFunction.Trim(S)
For i = 1 To Len(S)
    Sb = Mid(S, i, 1)
    Db = Mid(S, i + 1, 1)
    If Sb = Chr(32) Then
        If Asc(Db) >= 168 And Asc(Db) <= 184 Then
            k = Chr(32) & Chr(Asc(Db) - 7)
            i = i + 1
        Else
            k = Chr(32) & UCase(Db)
            i = i + 1
        End If
    Else
        k = Mid(S, i, 1)
    End If
    x = Trim(x & k)
Next i
Ustr = UCase(Left(x, 1)) & Mid(x, 2, Len(x) - 1)
    
End Function

 

[phamduylong]

chào thầy Long em thấy file này của pác hay lắm nhưng không thể nào xem được code, trong đó có lịch bằng UF em muốn xem thử

password: phamduylong hoặc pham_duy_long

 

[ongtrungducmx25]

password: phamduylong hoặc pham_duy_long

file này khác với file ở trên nên không thể nhập pass được pác xem lại cho em nhé!

 

[phamduylong]

file này khác với file ở trên nên không thể nhập pass được pác xem lại cho em nhé!

File đó đặt pass gì quên mất rồi. Gởi lại em file pass=phamduylong