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
Tự làm nhé:
+Tìm một hàm convert TCVN3 thành unicode.
+Dùng mấy hàm ở phía trên để bỏ dấu.
+Tìm hàm convert unicode thành TCVN3.

Nó hơi chậm chút, nhưng mà bạn tự làm được.
 
Upvote 0
Tự làm nhé:
+Tìm một hàm convert TCVN3 thành unicode.
+Dùng mấy hàm ở phía trên để bỏ dấu.
+Tìm hàm convert unicode thành TCVN3.

Nó hơi chậm chút, nhưng mà bạn tự làm được.

Cảm ơn bạn,hình như ngược lại phải là tìm hàm convert TCVN3 sang unicode thì mới sử dụng được các hàm trên?
Nhưng chẳng lẽ nhiều hàm loại dấu Unicode mà không có hàm loại dấu TCVN3 sao, buồn nhỉ :(
 
Upvote 0
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?
Thì code bài #9, cũng liệt kê từng ký tự ra thôi. Giờ có danh sách liệt kê các ký tự có dấu theo mã TCVN, thế vào code đó là xong chứ gì
 
Upvote 0
Cảm ơn bạn,hình như ngược lại phải là tìm hàm convert TCVN3 sang unicode thì mới sử dụng được các hàm trên?
Nhưng chẳng lẽ nhiều hàm loại dấu Unicode mà không có hàm loại dấu TCVN3 sao, buồn nhỉ :(
Các hàm trên đều bỏ dấu cho unicode, còn của bạn TCVN3, nên cần hai hàm hỗ trợ để chuyển qua chuyển lại ý .
 
  • Thích
Reactions: zou
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

Xin lỗi , phiền bạn có thể giải thích giúp các ký tự này và cách tra được không?

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"

Sao không phải là cả bảng chữ cái mà lại các chữ cái đại diện trùng lặp.
 
Upvote 0
Sub ToUnicode()'Chuyen tu TCVN sang UNICODE
ConvertStr Selection.Text, False
End Sub
Sub ToTCVN()'Chuyen tu UNICODE sang TCVN
ConvertStr Selection.Text, True
End Sub
Private Sub ConvertStr(Txt As String, Optional isReversed As Boolean = False)
Dim IStr$, I%, UN, VN
IStr = Txt

UN = Array(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, 192, 195, _
258, 194, 212, 416, 431, 272)

VN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
174, 193, 192, 195, 161, 162, 164, 165, 166, 167)

For I = 0 To 75
If isReversed And InStr(Txt, ChrW(UN(I))) <> 0 Then
IStr = Replace(IStr, ChrW(UN(I)), "[" & VN(I) & "]")
ElseIf InStr(IStr, ChrW(VN(I))) <> 0 Then
IStr = Replace(IStr, ChrW(VN(I)), "[" & UN(I) & "]")
End If
Next
If Len(IStr) <> Len(Txt) Then
For I = 0 To 75
If isReversed Then
IStr = Replace(IStr, "[" & VN(I) & "]", ChrW(VN(I)))
Else
IStr = Replace(IStr, "[" & UN(I) & "]", ChrW(UN(I)))
End If
Next
End If
Selection.Text = IStr
End Sub

Code trên mình lấy trên mạng, có thể lợi dụng các tham số trong hàm để dò tìm ra mã cũng những ký tự cần bỏ dấu.
 
  • Thích
Reactions: zou
Upvote 0
Cảm ơn bạn,hình như ngược lại phải là tìm hàm convert TCVN3 sang unicode thì mới sử dụng được các hàm trên?
Nhưng chẳng lẽ nhiều hàm loại dấu Unicode mà không có hàm loại dấu TCVN3 sao, buồn nhỉ :(
Bạn tham khảo thử. Code này trên GPE. Vì lý do tế nhị nên mình không đính kèm đường link ở đây
 

File đính kèm

  • Loai bo dau tieng viet1.xlsb
    57 KB · Đọc: 33
Upvote 0
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(190, 187, 188, 189, 198, 202, 199, 200, 201, 203, 184, 181, 182, 183, 185, 168, 169, 174, 213, 210, 211, 212, 214, 208, 204, 206, 207, 209, 170, 221, 215, 216, 220, 222, 232, 229, 230, 231, 233, 237, 234, 235, 236, 238, 227, 223, 225, 226, 228, 171, 172, 248, 245, 246, 247, 249, 243, 239, 241, 242, 244, 173, 253, 250, 251, 252, 254)
  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

Chế lại bằng cách thay đổi chút ý, cũng chưa test kỹ, giờ buồn ngủ rồi, tự test nhá.
 
  • Thích
Reactions: zou
Upvote 0
Cảm ơn bạn, nếu không có hàm loại dấu TCVN3 chắc cũng phải làm theo cách của bạn, chuyển qua Unicode rồi loại dấu.
Với code trên của bạn tôi chọn vùng font TCVN3 sau đó, chạy sub ToUnicode
thì lỗi:

1528009511591.png
nhờ bạn xem giúp.
 
Upvote 0
A, đúng ý mình rồi.
Cảm ơn bạn nhiều.
Cái đó nó còn có chức năng convert font nữa đó
LoaiDau(ByVal text As String, source As convert_source, dest As convert_dest)
source , dest trong hàm là uni = 1: vni = 2: vn3 = 3: windows1258 = 4
 
Lần chỉnh sửa cuối:
  • Thích
Reactions: zou
Upvote 0
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(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, 201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, 222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, 238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, 174, 184, 181, 183, 161, 162, 164, 165, 166, 167)
  ResText = "aaaaaaaaaaaaaaaaaeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyydAAAAAOOUD"
  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

Nói chung là nhức đầu,
 

File đính kèm

  • 1598753.png
    1598753.png
    42.3 KB · Đọc: 10
  • Thích
Reactions: zou
Upvote 0
Upvote 0
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(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, 201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, 222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, 238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, 174, 184, 181, 183, 161, 162, 164, 165, 166, 167)
  ResText = "aaaaaaaaaaaaaaaaaeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyydAAAAAOOUD"
  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

Nói chung là nhức đầu,

Hi, làm phiền bạn rồi (_ _)
 
Upvote 0
Lợi hại thiệt ha, nhưng mình chưa biết cách dùng cho trường hợp convert :(
Ví dụ
Chuyển về không dấu với số màu cam nhận từ 1 đến 4 theo bài trên (5 là bỏ dấu) thì B2=Loaidau(A2;3;5) . Trong ví dụ này 3 là TCVN3
Còn convert font thì số màu cam nhận từ 1 đến 4, màu xanh nhận từ 1 đến 4: Ví dụ B2=Loaidau(A2;3;1) có nghĩa là convert font từ TCVN3 --> Unicode
Cứ thế mà đảo thui. Tùy vào font nguồn là loại gì và cần chuyển ra font gì :p:p:p
 
Upvote 0
Ví dụ
Chuyển về không dấu với số màu cam nhận từ 1 đến 4 theo bài trên (5 là bỏ dấu) thì B2=Loaidau(A2;3;5) . Trong ví dụ này 3 là TCVN3
Còn convert font thì số màu cam nhận từ 1 đến 4, màu xanh nhận từ 1 đến 4: Ví dụ B2=Loaidau(A2;3;1) có nghĩa là convert font từ TCVN3 --> Unicode
Cứ thế mà đảo thui. Tùy vào font nguồn là loại gì và cần chuyển ra font gì :p:p:p

Ồ, thì ra là vậy, giờ thì mình đã biết cách dùng.
Cảm ơn bạn nhiều nhé.

A bạn cho hỏi thêm trong file kèm hàm sử dụng giống công thức để loại dấu cho từng chuỗi một.

Nếu mình muốn sử dụng sub chuyển font hoặc loại dấu cho cả một vùng lớn mà không phải gõ công thức kéo lên xuống dưới hay kéo sang phải sang trái chỉ cần chạy sub là xong,vi dụ từ A1:B5000 thì code của sub chuyển dấu và code của sub loại dấu phải viết thế nào?
 
Lần chỉnh sửa cuối:
Upvote 0
Ồ, thì ra là vậy, giờ thì mình đã biết cách xài. Cảm ơn bạn nhé.

A bạn cho hỏi thêm đó là mình sử dụng hàm để chuyển cho từng chuỗi một.

Nếu mình muốn sử dụng sub chuyển font hoặc loại dấu cho cả một vùng lớn ví dụ từ A1:B5000 thì code của sub chuyển dấu và code của sub loại dấu phải viết thế nào?
Cái đầu vào nó là vầy mà bạn ByVal text As String
Bạn chạy thử cái này xem: Đang từ 3 sang 1 nha
Mã:
Sub Chuyenfont()
    Dim sArr, dArr, I As Long, J As Long
sArr = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
For I = 1 To UBound(sArr, 1)
    For J = 1 To UBound(sArr, 2)
        dArr(I, J) = LoaiDau(sArr(I, J), 3, 1)
    Next J
Next I
Range("J1").Resize(UBound(sArr, 1), UBound(sArr, 2)) = dArr
End Sub
 
  • Thích
Reactions: zou
Upvote 0
Bạn dùng cái này cho cơ động(Hôm nay mình đang rảnh mà :p:p:p)
Mã:
Sub Chuyenfont()
    Dim sRng As Range, eRng As Range, source As Long, dest As Long
    Dim sArr, dArr, I As Long, J As Long
        On Error GoTo 0
Set sRng = Application.InputBox(Prompt:="chon vung du lieu ", Title:="Chon du lieu dau vao", Type:=8)
source = InputBox("Nhap so cot can chen " & Chr(10) & "(uni = 1: vni = 2: vn3 = 3: windows1258 = 4: khongdau = 5): ")
dest = InputBox("Nhap so cot can chen " & Chr(10) & "(uni = 1: vni = 2: vn3 = 3: windows1258 = 4: khongdau = 5): ")
sArr = sRng.Value
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
For I = 1 To UBound(sArr, 1)
    For J = 1 To UBound(sArr, 2)
        dArr(I, J) = LoaiDau(sArr(I, J), source, dest)
    Next J
Next I
Set eRng = Application.InputBox(Prompt:="Chon o chua du lieu ", Title:="Ghi du lieu", Type:=8)
eRng.Resize(UBound(sArr, 1), UBound(sArr, 2)) = dArr
End Sub
 
  • Thích
Reactions: zou
Upvote 0
Cái đầu vào nó là vầy mà bạn ByVal text As String
Bạn chạy thử cái này xem: Đang từ 3 sang 1 nha
Mã:
Sub Chuyenfont()
    Dim sArr, dArr, I As Long, J As Long
sArr = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
For I = 1 To UBound(sArr, 1)
    For J = 1 To UBound(sArr, 2)
        dArr(I, J) = LoaiDau(sArr(I, J), 3, 1)
    Next J
Next I
Range("J1").Resize(UBound(sArr, 1), UBound(sArr, 2)) = dArr
End Sub

Cảm ơn bạn nhiều,sau một hồi được bạn tận tình chỉ dẫn,mình đã ứng dụng được vào công việc. SƯỚNG QUÁ!!!!!!! HÔ HÔ HÔ =)))
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom