Cách chuyển đổi từ Tiếng Việt có dấu thành không dấu

Liên hệ QC

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia
17/4/16
Bài viết
2,701
Được thích
2,433
Giới tính
Nam
Nghề nghiệp
Nhân viên kỹ thuật in ấn
Chào mọi người!

Em có vấn đề nhờ mọi người giúp!

Em muốn chuyển tất cả chuỗi có dấu thành chuôi không dấu.(Xem trong file đính kèm)

Em cảm ơn mọi người nhiều!
 

File đính kèm

  • chuyen dau.xlsx
    9 KB · Đọc: 17
Chào mọi người!

Em có vấn đề nhờ mọi người giúp!

Em muốn chuyển tất cả chuỗi có dấu thành chuôi không dấu.(Xem trong file đính kèm)

Em cảm ơn mọi người nhiều!
Mình kiếm được cái hàm này bạn tham khảo thử
PHP:
Function ConvertToUnSign(ByVal sContent As String) As String

     Dim i As Long

     Dim intCode As Long

     Dim sChar As String

     Dim sConvert As String

     ConvertToUnSign = AscW(sContent)

     For i = 1 To Len(sContent)

        sChar = Mid(sContent, i, 1)

        If sChar <> "" Then

            intCode = AscW(sChar)

        End If

        Select Case intCode

            Case 273

                sConvert = sConvert & "d"

            Case 272

                sConvert = sConvert & "D"

            Case 224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, 7863

                sConvert = sConvert & "a"

            Case 192, 193, 194, 195, 258, 7840, 7842, 7844, 7846, 7848, 7850, 7852, 7854, 7856, 7858, 7860, 7862

                sConvert = sConvert & "A"

            Case 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879

                sConvert = sConvert & "e"

            Case 200, 201, 202, 7864, 7866, 7868, 7870, 7872, 7874, 7876, 7878

                sConvert = sConvert & "E"

            Case 236, 237, 297, 7881, 7883

                sConvert = sConvert & "i"

            Case 204, 205, 296, 7880, 7882

                sConvert = sConvert & "I"

            Case 242, 243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907

                sConvert = sConvert & "o"

            Case 210, 211, 212, 213, 416, 7884, 7886, 7888, 7890, 7892, 7894, 7896, 7898, 7900, 7902, 7904, 7906

                sConvert = sConvert & "O"

            Case 249, 250, 361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921

                sConvert = sConvert & "u"

            Case 217, 218, 360, 431, 7908, 7910, 7912, 7914, 7916, 7918, 7920

                sConvert = sConvert & "U"

            Case 253, 7923, 7925, 7927, 7929

                sConvert = sConvert & "y"

            Case 221, 7922, 7924, 7926, 7928

                sConvert = sConvert & "Y"

            Case Else

                sConvert = sConvert & sChar

        End Select

     Next

     ConvertToUnSign = sConvert

  End Function
 

File đính kèm

  • chuyen dau.xls
    37 KB · Đọc: 24
Upvote 0
Mình cũng có cái ni, bạn tạm tham khảo nè:
PHP:
Function BoDauTV(ByVal Txt As String) As String
 Dim Charcode(), ResTxt(), I As Long, Tmp As String
 Tmp = UCase$(Txt)
 Charcode = Array(7862, 7860, 7858, 7856, 7854, 7852, 7850, 7848, 7846, 7844, 7842, 7840, 258, 195, 194, 193, 192 _
    , 7878, 7876, 7874, 7872, 7870, 7868, 7866, 7864, 202, 201, 200, 7882, 7880, 296, 205, 204, 272 _
    , 7990, 7906, 7904, 7902, 7898, 7896, 7894, 7892, 7890, 7888, 7886, 7884, 416, 213, 212, 211, 210 _
    , 7920, 7918, 7916, 7914, 7912, 7910, 431, 360, 218, 217, 7928, 7926, 7924, 7922, 221)
   
 ResTxt = Array("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A" _
    , "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "F" _
    , "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O" _
    , "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y")
 For I = 0 To UBound(Charcode)
    Tmp = Replace(Tmp, ChrW(Charcode(I)), ResTxt(I))
 Next
 BoDauTV = Tmp
End Function
Mã:
Function LoaiDauTV(ByVal Text As String) As String
 Dim Charcode(), ResTxt(), I As Long, Tmp As String
 Tmp = Text
 Charcode = Array(224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, _
    7863, 273, 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879, 236, 237, 297, 7881, 7883, 242, _
        243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 249, 250, _
            361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7925, 7927, 7929)
           
 ResTxt = Array("a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", _
    "F", "e", "e", "e", "e", "e", "e", "e", "e", "e", "e", "e", "i", "i", "i", "i", "i", "o", "o", _
        "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "u", "u", "u", "u", "u", _
            "u", "u", "u", "u", "u", "u", "y", "y", "y", "y", "y")      'd'
 For I = 0 To UBound(Charcode)
    Tmp = Replace(Tmp, ChrW(Charcode(I)), ResTxt(I))
    Tmp = Replace(Tmp, UCase(ChrW(Charcode(I))), UCase(ResTxt(I)))
 Next
 LoaiDauTV = Tmp
 End Function
 
Upvote 0
Mình kiếm được cái hàm này bạn tham khảo thử
PHP:
Function ConvertToUnSign(ByVal sContent As String) As String
...

Cái hàm của bạn dùng phép nối chuỗi trong trường hợp này rất là hao tổn năng lượng.

Đây là trường hợp đổi ký tự - > ký tự. Chuỗi vào và chuỗi ra dài bằng nhau cho nên bạn có thể dùng hàm Mid để đổi ký tự.
For i = 1 to Len(chuoiVao)
Mid(chuoiRa, i, 1) = ChuyenDang(Mid(chuoiVao, i, 1))
Next i
 
Upvote 0
Cái hàm của bạn dùng phép nối chuỗi trong trường hợp này rất là hao tổn năng lượng.

Đây là trường hợp đổi ký tự - > ký tự. Chuỗi vào và chuỗi ra dài bằng nhau cho nên bạn có thể dùng hàm Mid để đổi ký tự.
For i = 1 to Len(chuoiVao)
Mid(chuoiRa, i, 1) = ChuyenDang(Mid(chuoiVao, i, 1))
Next i
Cái đó em đi "Chôm" về Thầy ạ . Chứ Em làm sao mà viết được cái hàm đó ạ./
 
Upvote 0
Mình cũng có cái ni, bạn tạm tham khảo nè:
PHP:
Function BoDauTV(ByVal Txt As String) As String
 Dim Charcode(), ResTxt(), I As Long, Tmp As String
 Tmp = UCase$(Txt)
 Charcode = Array(7862, 7860, 7858, 7856, 7854, 7852, 7850, 7848, 7846, 7844, 7842, 7840, 258, 195, 194, 193, 192 _
    , 7878, 7876, 7874, 7872, 7870, 7868, 7866, 7864, 202, 201, 200, 7882, 7880, 296, 205, 204, 272 _
    , 7990, 7906, 7904, 7902, 7898, 7896, 7894, 7892, 7890, 7888, 7886, 7884, 416, 213, 212, 211, 210 _
    , 7920, 7918, 7916, 7914, 7912, 7910, 431, 360, 218, 217, 7928, 7926, 7924, 7922, 221)
 
 ResTxt = Array("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A" _
    , "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "F" _
    , "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O" _
    , "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y")
 For I = 0 To UBound(Charcode)
    Tmp = Replace(Tmp, ChrW(Charcode(I)), ResTxt(I))
 Next
 BoDauTV = Tmp
End Function
Mã:
Function LoaiDauTV(ByVal Text As String) As String
 Dim Charcode(), ResTxt(), I As Long, Tmp As String
 Tmp = Text
 Charcode = Array(224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, _
    7863, 273, 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879, 236, 237, 297, 7881, 7883, 242, _
        243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 249, 250, _
            361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7925, 7927, 7929)
        
 ResTxt = Array("a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", _
    "F", "e", "e", "e", "e", "e", "e", "e", "e", "e", "e", "e", "i", "i", "i", "i", "i", "o", "o", _
        "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "o", "u", "u", "u", "u", "u", _
            "u", "u", "u", "u", "u", "u", "y", "y", "y", "y", "y")      'd'
 For I = 0 To UBound(Charcode)
    Tmp = Replace(Tmp, ChrW(Charcode(I)), ResTxt(I))
    Tmp = Replace(Tmp, UCase(ChrW(Charcode(I))), UCase(ResTxt(I)))
 Next
 LoaiDauTV = Tmp
 End Function
Hai hàm Bác đưa lại có lỗi sai:
Chữ Đ lại biến thành chữ F.

Em cảm ơn Bác nhiều!
 
Upvote 0
Mình kiếm được cái hàm này bạn tham khảo thử
PHP:
Function ConvertToUnSign(ByVal sContent As String) As String

     Dim i As Long

     Dim intCode As Long

     Dim sChar As String

     Dim sConvert As String

     ConvertToUnSign = AscW(sContent)

     For i = 1 To Len(sContent)

        sChar = Mid(sContent, i, 1)

        If sChar <> "" Then

            intCode = AscW(sChar)

        End If

        Select Case intCode

            Case 273

                sConvert = sConvert & "d"

            Case 272

                sConvert = sConvert & "D"

            Case 224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, 7863

                sConvert = sConvert & "a"

            Case 192, 193, 194, 195, 258, 7840, 7842, 7844, 7846, 7848, 7850, 7852, 7854, 7856, 7858, 7860, 7862

                sConvert = sConvert & "A"

            Case 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879

                sConvert = sConvert & "e"

            Case 200, 201, 202, 7864, 7866, 7868, 7870, 7872, 7874, 7876, 7878

                sConvert = sConvert & "E"

            Case 236, 237, 297, 7881, 7883

                sConvert = sConvert & "i"

            Case 204, 205, 296, 7880, 7882

                sConvert = sConvert & "I"

            Case 242, 243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907

                sConvert = sConvert & "o"

            Case 210, 211, 212, 213, 416, 7884, 7886, 7888, 7890, 7892, 7894, 7896, 7898, 7900, 7902, 7904, 7906

                sConvert = sConvert & "O"

            Case 249, 250, 361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921

                sConvert = sConvert & "u"

            Case 217, 218, 360, 431, 7908, 7910, 7912, 7914, 7916, 7918, 7920

                sConvert = sConvert & "U"

            Case 253, 7923, 7925, 7927, 7929

                sConvert = sConvert & "y"

            Case 221, 7922, 7924, 7926, 7928

                sConvert = sConvert & "Y"

            Case Else

                sConvert = sConvert & sChar

        End Select

     Next

     ConvertToUnSign = sConvert

  End Function

Cảm ơn Bạn nhiều nha!

Chúc Bạn ngày cuối tuần vui!
 
Upvote 0
Tìm mấy cái hàm của bạn ndu (*)

(*) xin lỗi, cái số đi sau dài quá tôi không nhớ nổi. :sweatdrop::sweatdrop::sweatdrop:
Dạ, số dài là 96081631 ạ!
Còn cái hàm "zin chính chủ" đó là:
Mã:
Function RemoveMarks(ByVal Text As String) As String
  Dim CharCode, i As Long
  Dim ResText As String, sTmp As String
  On Error Resume Next
  sTmp = Text
  CharCode = Array(7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 225, _
                   224, 7843, 227, 7841, 259, 226, 273, 7871, 7873, 7875, 7877, 7879, _
                   233, 232, 7867, 7869, 7865, 234, 237, 236, 7881, 297, 7883, 7889, _
                   7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 243, 242, _
                   7887, 245, 7885, 244, 417, 7913, 7915, 7917, 7919, 7921, 250, _
                   249, 7911, 361, 7909, 432, 253, 7923, 7927, 7929, 7925)
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  For i = 0 To UBound(CharCode)
    sTmp = Replace(sTmp, ChrW(CharCode(i)), Mid(ResText, i + 1, 1))
    sTmp = Replace(sTmp, UCase(ChrW(CharCode(i))), UCase(Mid(ResText, i + 1, 1)))
  Next
  RemoveMarks = sTmp
End Function
 
Upvote 0
Dạ, số dài là 96081631 ạ!
Còn cái hàm "zin chính chủ" đó là:
Mã:
Function RemoveMarks(ByVal Text As String) As String
  Dim CharCode, i As Long
  Dim ResText As String, sTmp As String
  On Error Resume Next
  sTmp = Text
  CharCode = Array(7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 225, _
                   224, 7843, 227, 7841, 259, 226, 273, 7871, 7873, 7875, 7877, 7879, _
                   233, 232, 7867, 7869, 7865, 234, 237, 236, 7881, 297, 7883, 7889, _
                   7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 243, 242, _
                   7887, 245, 7885, 244, 417, 7913, 7915, 7917, 7919, 7921, 250, _
                   249, 7911, 361, 7909, 432, 253, 7923, 7927, 7929, 7925)
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  For i = 0 To UBound(CharCode)
    sTmp = Replace(sTmp, ChrW(CharCode(i)), Mid(ResText, i + 1, 1))
    sTmp = Replace(sTmp, UCase(ChrW(CharCode(i))), UCase(Mid(ResText, i + 1, 1)))
  Next
  RemoveMarks = sTmp
End Function
Em cảm ơn Thầy nhiều!

code quá tuyệt vời luôn.

Chúc Thầy ngày cuối tuần vui vẻ!
 
Upvote 0
Hai hàm Bác đưa lại có lỗi sai:
Chữ Đ lại biến thành chữ F!
Thế bạn cho nó thành 'D' mới là đúng ư? Đó là quan niệm của rất, rất nhiều người Việt ta thôi;
Nhưng vài người, trong đó có mình, cho rằng dịch sang thành 'F' trong vài trường hợp lại là đúng thì sao nào?
 
Upvote 0
Mới chế xong, chỉ tội tốn ram chút nhưng tốc độ khá được.

<< Link >>

Còn vài cách nữa, nhưng tốc độ cao quá sợ nguy hiểm nên không dám viết.

Đi tùm lum chi cho mệt.
Dùng cây nhà lá vườn ở đây nó có bảo hành. Cần chỉnh sửa đưa lại khổ chủ là xong.
 
Upvote 0
Upvote 0
Góp ý cho các bạn viết hàm này:

Cái dấu này nọ của các ngôn ngữ không La tinh, tiếng Anh gọi là "diacritic marks"
Bỏ đi các dấu trên tức là đưa các ký tự về dạng Latin chuẩn. Hành động này tiếng Anh gọi là Latinise (-ize, tùy theo bạn dùng British hay American English)

Thực ra, Latinise/ize có nghĩa rộng hơn. Nhưng ở đây gọi tạm vậy cũng được.
Nếu tôi có quyền đặt từ thì tôi gọi nó là dediacritic. Rất tiếc từ này tự điển không có, nói bậy bạ thiên hạ chửi thúi đầu.
 
Upvote 0
Chào các bạn,các hàm trên chỉ loại dấu được font unicode phải không?
Nếu muốn loại dấu của font TCVN3 dùng hàm nào vậy?
 
Upvote 0
Chào các bạn,các hàm trên chỉ loại dấu được font unicode phải không?
Nếu muốn loại dấu của font TCVN3 dùng hàm nào vậy?
Cũng theo nguyên tắc các code trên mà viết: Tra từ ký tự rồi thay thực thế
Cực là cực công liệt kê danh sách các ký tự có dấu ra thôi
 
  • Thích
Reactions: zou
Upvote 0
Cũng theo nguyên tắc các code trên mà viết: Tra từ ký tự rồi thay thực thế
Cực là cực công liệt kê danh sách các ký tự có dấu ra thôi

Cảm ơn bạn, tôi chưa biết cách làm (tra từ ký tự và thay thực tế) bạn có thể hướng dẫn chi tiết giúp tôi được không?
 
Upvote 0
Cách tốt nhất Unikey.

Unikey.jpg

Lê Văn Duyệt
 
Upvote 0
Web KT
Back
Top Bottom