Bạn sử dụng chức năng tìm kiếm của diễn đàn đi.Em có 1 danh sách nhập tên là chữ có dấu và em muốn chuyển thành chữ không có dấu. Xin anh, chị cho em xin 1 đoạn code ạ. Em xin cảm ơn trước ạ
Bạn lên mạng tìm addin chuyển dấu thành không dấu của Phạm Duy Long. Sẽ ra được yêu cầu của bạn.Dạ em có tìm trên diễn đàn rồi và dùng Unikey thì em biết. Em muốn dùng 1 hàm tự tạo gì đó để máy tự chuyển đổi.
Ví dụ như tại bài này là một tham khảo. Xin trích dẫn code trong Add-in này lên đây để bạn tiên theo dõi:Dạ em có tìm trên diễn đàn rồi và dùng Unikey thì em biết. Em muốn dùng 1 hàm tự tạo gì đó để máy tự chuyển đổi.
FConst CodUni = "225 224 7843 227 7841 259 7855 7857 7859 7861 7863 226 7845 7847 7849 7851 7853 233 232 7867 7869 7865 234 7871 7873 7875 7877 7879 237 236 7881 297 7883 243 242 7887 245 7885 244 7889 7891 7893 7895 7897 417 7899 7901 7903 7905 7907 250 249 7911 361 7909 432 7913 7915 7917 7919 7921 253 7923 7927 7929 7925 273 193 193 192 192 7842 7842 195 195 7840 7840 258 258 7854 7854 7856 7856 7858 7858 7860 7860 7862 7862 194 194 7844 7844 7846 7846 7848 7848 7850 7850 7852 7852 201 201 200 200 7866 7866 7868 7868 7864 7864 202 202 7870 7870 7872 7872 7874 7874 7876 7876 7878 7878 205 204 7880 296 7882 211 211 210 210 7886 7886 213 213 7884 7884 212 212 7888 7888 7890 7890 7892 7892 7894 7894 7896 7896 416 7898 7898 7900 7900 7902 7902 7904 7904 7906 7906 218 218 217 217 7910 7910 360 360 7908 7908 431 7912 7912 7914 7914 7916 7916 7918 7918 7920 7920 221 221 7922 7922 7926 7926 7928 7928 7924 272 "
Const Str0dau = "aaaaaaaaaaaaaaaaaeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyydAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEEEEEEEEEEEEEEEEEEEEEEIIIIIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOUUUUUUUUUUUUUUUUUUUUUYYYYYYYYYD"
Function LoaiDauUni(Text As String) As String
Text = Text & " "
madau = " "
For n = 1 To Len(Text) - 1
kytu = Mid(Text, n, 1)
codkytu = AscW(kytu) & String(5 - Len(CStr(AscW(kytu))), " ")
vitri = (InStr(1, CodUni, codkytu, 0) + 4) / 5
If vitri >= 1 Then
NewText = NewText & Mid(Str0dau, vitri, 1)
Else
NewText = NewText & kytu
End If
Next
LoaiDauUni = NewText
End Function
Nếu loại dấu cho 1 vài ký tự thì không nói làm gì! Đặt trường hợp phải loại dấu cho 1 văn bản dài thì code này không phải là giài pháp tốt (vì phải For.. Next nguyên chuổi)Ví dụ như tại bài này là một tham khảo. Xin trích dẫn code trong Add-in này lên đây để bạn tiên theo dõi:
PHP:FConst CodUni = "225 224 7843 227 7841 259 7855 7857 7859 7861 7863 226 7845 7847 7849 7851 7853 233 232 7867 7869 7865 234 7871 7873 7875 7877 7879 237 236 7881 297 7883 243 242 7887 245 7885 244 7889 7891 7893 7895 7897 417 7899 7901 7903 7905 7907 250 249 7911 361 7909 432 7913 7915 7917 7919 7921 253 7923 7927 7929 7925 273 193 193 192 192 7842 7842 195 195 7840 7840 258 258 7854 7854 7856 7856 7858 7858 7860 7860 7862 7862 194 194 7844 7844 7846 7846 7848 7848 7850 7850 7852 7852 201 201 200 200 7866 7866 7868 7868 7864 7864 202 202 7870 7870 7872 7872 7874 7874 7876 7876 7878 7878 205 204 7880 296 7882 211 211 210 210 7886 7886 213 213 7884 7884 212 212 7888 7888 7890 7890 7892 7892 7894 7894 7896 7896 416 7898 7898 7900 7900 7902 7902 7904 7904 7906 7906 218 218 217 217 7910 7910 360 360 7908 7908 431 7912 7912 7914 7914 7916 7916 7918 7918 7920 7920 221 221 7922 7922 7926 7926 7928 7928 7924 272 " Const Str0dau = "aaaaaaaaaaaaaaaaaeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyydAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEEEEEEEEEEEEEEEEEEEEEEIIIIIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOUUUUUUUUUUUUUUUUUUUUUYYYYYYYYYD" Function LoaiDauUni(Text As String) As String Text = Text & " " madau = " " For n = 1 To Len(Text) - 1 kytu = Mid(Text, n, 1) codkytu = AscW(kytu) & String(5 - Len(CStr(AscW(kytu))), " ") vitri = (InStr(1, CodUni, codkytu, 0) + 4) / 5 If vitri >= 1 Then NewText = NewText & Mid(Str0dau, vitri, 1) Else NewText = NewText & kytu End If Next LoaiDauUni = NewText End Function
Function RemoveMarks(ByVal Text As String) As String
Dim CharCode, ResText As String, i As Long, Tmp As String
On Error Resume Next
Tmp = Text
CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
For i = 0 To UBound(CharCode)
Tmp = Replace(Tmp, CharCode(i), Mid(ResText, i + 1, 1))
Tmp = Replace(Tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
Next
RemoveMarks = Tmp
End Function
Nếu chưa biết bảng mã gì thì viết chương trình sẽ phức tạp.
Nếu loại dấu cho 1 vài ký tự thì không nói làm gì! Đặt trường hợp phải loại dấu cho 1 văn bản dài thì code này không phải là giài pháp tốt (vì phải For.. Next nguyên chuổi)
Cách của tôi là For... Next trong "thư viện" các ký tự cho sẵn rồi dùng Replace thay thế tương ứng ---> Nó sẽ cho tốc độ nhanh với 1 văn bản dài
PHP:Function RemoveMarks(ByVal Text As String) As String Dim CharCode, ResText As String, i As Long, Tmp As String On Error Resume Next Tmp = Text CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _ ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _ ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _ ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _ ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _ ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _ ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _ ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _ ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925)) ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy" For i = 0 To UBound(CharCode) Tmp = Replace(Tmp, CharCode(i), Mid(ResText, i + 1, 1)) Tmp = Replace(Tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1))) Next RemoveMarks = Tmp End Function
- Khởi động ExcelChèn méc ơi. Cái này sử dụng ra sao vậy anh mình. Em có thử trong file của em rồi nhưng code chưa chạy nữa. Anh gữi file kèm dùm em đi anh.
Function BoDau_Ndu(ByVal Text As String) As String
Dim CharCode, ResText As String, i As Long, Tmp As String
On Error Resume Next
Tmp = Text
CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
For i = 0 To UBound(CharCode)
Tmp = Replace(Tmp, CharCode(i), Mid(ResText, i + 1, 1))
Tmp = Replace(Tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
Next
BoDau_Ndu = Tmp
End Function
Sub BoDau()
For Each cls In Selection
cls.Value = BoDau_Ndu(cls)
Next
End Sub
Anh đừng chạy trực tiếp trên cell... Có thể viết thêm 1 sub (với tham số truyền) và chạy trên Array sẽ nhanh hơn anh àXin phép Ndu cho bổ sung thêm 1 ý kiến nhỏ:
Trường hợp muốn bỏ dấu của dữ liệu nguồn ta quét chọn vùng và chạy Sub BoDau.
Mã:Function BoDau_Ndu(ByVal Text As String) As String Dim CharCode, ResText As String, i As Long, Tmp As String On Error Resume Next Tmp = Text CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _ ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _ ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _ ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _ ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _ ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _ ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _ ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _ ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925)) ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy" For i = 0 To UBound(CharCode) Tmp = Replace(Tmp, CharCode(i), Mid(ResText, i + 1, 1)) Tmp = Replace(Tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1))) Next BoDau_Ndu = Tmp End Function
Mã:Sub BoDau() For Each cls In Selection cls.Value = BoDau_Ndu(cls) Next End Sub
Cái này lại phải nhờ bạn làm giúp, tôi chưa biết viết sub (với tham số truyền) chạy trên Array như thế nào.Anh đừng chạy trực tiếp trên cell... Có thể viết thêm 1 sub (với tham số truyền) và chạy trên Array sẽ nhanh hơn anh à
Một ý kiến thật là sâu sắc, xin tiếp thu và sẽ cố gắng học để làm theo bạn.Ngoài ra, em xin phát biểu ý kiến riêng của em:
Ta nên suy nghĩ xa hơn... Một ngày nào đó bọn Tây nó vào trang GPE của mình thì đằng nào khi nó đọc 1 code với các tên biến theo chuẩn quốc tế, nó sẽ cảm thấy dễ hiểu (biết đâu từ đó nó thích thú và quay lại GPE nhiều hơn)
Nếu loại dấu cho 1 vài ký tự thì không nói làm gì! Đặt trường hợp phải loại dấu cho 1 văn bản dài thì code này không phải là giài pháp tốt (vì phải For.. Next nguyên chuổi)
Cách của tôi là For... Next trong "thư viện" các ký tự cho sẵn rồi dùng Replace thay thế tương ứng ---> Nó sẽ cho tốc độ nhanh với 1 văn bản dài
Chuyển mọi bảng mã về Unicode trên GPE mình đã làm rồi mà anh! Vấn đề là anh phải xác định trước bảng mã nguồn, còn chuyện làm cách nào đó để code có thể phát hiện ra bảng mã 1 cách tự động thì... thua (em chưa thấy loại code này và em cũng không làm nỗi)
Khi đọc bài này của Ndu tôi đang đặt câu hỏi: có thể dùng phương pháp này để chuyển các loại Font... về UniCode được không ? Bạn nào làm được thì viết giúp tôi một UDF. Tôi cũng đang mò mẫm làm thử nhưng vì chưa thạo viết UDF nên không hy vọng sẽ thành công.
Khi đọc bài này của Ndu tôi đang đặt câu hỏi: có thể dùng phương pháp này để chuyển các loại Font... về UniCode được không ?
Code của thầy Ndu sao mình đánh Vni Win nó ko đúng nhỉ?