Chuyển chữ có dấu thành chữ không có dấu (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

minhhangg

Thành viên hoạt động
Tham gia
4/5/11
Bài viết
197
Được thích
61
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 ạ
 

File đính kèm

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 sử dụng chức năng tìm kiếm của diễn đàn đi.
Một cách nhanh gọn và không phải suy nghĩ gì là hãy sử dụng chức năng chuyển mã của Unikey với lựa chọn Loại bỏ dấu.
 
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.
 
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.
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:
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
 
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
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
 
Nếu biết chắc bảng mã (như trong file đính kèm của minhhangg, bảng mã Unicode) thì dễ lập mã.
Nếu chưa biết bảng mã gì thì viết chương trình sẽ phức tạp.

Tóm lại làm làm thủ công như anh nghiaphuc đã gởi trả lời
 
Nếu chưa biết bảng mã gì thì viết chương trình sẽ phức tạp.

Nói thật, đến thời điểm hiện tại, tôi chưa thấy chương trình nào có khả năng tự nhận dạng bảng mã cả
Đương nhiên cái kiểu "nhận dạng" thông qua font name thì khỏi cần bàn đến đi... ví đó không phải là giải pháp triệt để
 
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

Chè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.
 
Chè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.
- Khởi động Excel
- Bấm Alt + F11 để vào cửa sổ lập trình
- Vào menu Insert, chọn Module
- Copy code của tôi, paste vào khung bên phải của module
- Bấm Alt + Q để trở về bảng tính
- Giờ thì cứ việc dùng hàm trên như hàm có sẵn thôi (bằng cách bấm nút Fx, bấm mũi tên xổ xuống, chọn mục User Defined, chọn hàm RemoveMarks và... dùng)
-----------
Xem file
 

File đính kèm

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
 
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
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 à
----------------------------------------------
Ngoài ra, em xin phát biểu ý kiến riêng của em:
- Em rất ghét đặt biến, tên hàm, tên Sub... bằng tiếng Việt (không phải vì em giỏi tiếng Anh) mà vì tên biến bằng tiếng Anh rất súc tích, ngắn gọn
- 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)
- vân vân và vân vân
Đương nhiên đây chỉ là ý kiến cá nhân, mong anh và các thành viên khác đừng giận!
 
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 à
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.

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

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

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.​
 
Lần chỉnh sửa cuố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.​
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 ?​

Để biết các loại Font, ta phải biết bảng mã của nó. Nếu biết rồi, có ông tin học nào đó tạo thêm bảng mã mới thì làm sao để biết "các loại Font"

Cho nên chuyển mã vẫn là thủ công. Nhưng cũng có thể lập code nhưng chỉ làm các Font khá thông dụng.

Để nhất quán, cần có quy định pháp lý được dùng 1 số Font nào đó (vì nhiều phần mềm hiện vẫn không dùng bảng mã Unicode), dạng văn bản (như Word) phải dùng Unicode.

Hình như Chính phủ có quy định bảng mã trong văn bản chính thức của Việt Nam phải dùng Unicode.
 
Code của thầy Ndu sao mình đánh Vni Win nó ko đúng nhỉ?
 
Code của thầy Ndu sao mình đánh Vni Win nó ko đúng nhỉ?

Chỉ đúng với bảng mã Unicode thôi bạn à (mà phải là Unicode dựng sẵn)
Nếu muốn dùng với các bảng mã khác, phải sửa lại code ---> Các bạn tự sửa lại đi, vấn đề chỉ là xây dựng lại "thư viên" cho phù hợp mà thôi (giải thuật vẫn như cũ)
 
Web KT

Bài viết mới nhất

Back
Top Bottom