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ì
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 ý .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 ở đâyCả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ỉ
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
Cái đó nó còn có chức năng convert font nữa đó
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 FunctionVí dụ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ì
Cái đầu vào nó là vầy mà bạn ByVal text As String
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 SubSub 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
