Nhờ giúp chuyển chữ dạng ký hiệu sang chữ bình thường (1 người xem)

hung2412 · 14/8/20

Xin chào các bạn GPE!
Tôi có 1 bảng tính gồm các chữ dạng ký hiệu như vầy:

Tôi muốn chuyển từ dạng chữ trên sang dạng chữ bình thường Time New Roman dạng như vầy thì làm thế nào?:

Xin cảm ơn các bạn!

huuthang_bd · 14/8/20

Nếu bạn sử dụng phiên bản Excel 2013 trở lên thì dùng cách sau:

Nhập công thức sau vào ô D4

Mã:

="="&SUBSTITUTE(B4,"ChrW$","UNICHAR")

Copy cho các ô còn lại
Copy - paste value các công thức vừa làm
Dùng Find and Replace thay thế dấu = bằng dấu =

huuthang_bd · 14/8/20

UDF cho Excel phiên bản cũ.

Mã:

Function GPE(ByVal sStr As String) As String
Dim Arr As Variant, i As Long
Arr = Split(sStr, "&")
For i = LBound(Arr, 1) To UBound(Arr)
    If (Len(Arr(i)) - Len(Replace(Arr(i), """", ""))) Mod 2 = 1 Then
        Arr(i + 1) = Arr(i) & "&" & Arr(i + 1)
        Arr(i) = ""
    ElseIf Left(Arr(i), 5) = "ChrW$" Then
        Arr(i) = ChrW$(CLng(Mid(Arr(i), 7, Len(Arr(i)) - 7)))
    Else
        Arr(i) = Replace(Arr(i), """""", """")
        Arr(i) = Mid(Arr(i), 2, Len(Arr(i)) - 2)
    End If
Next
GPE = Join(Arr, "")
End Function

Phuocam · 14/8/20

Hoặc thử UDF:

PHP:

Function ChuyenFont(ByVal S As String) As String
Dim v As Variant

For Each v In Split(Replace(S, """", ""), "&")
    If Left(v, 5) = "ChrW$" Then v = ChrW(Val(Mid(v, 7)))
    ChuyenFont = ChuyenFont & v
Next

End Function

HeSanbi · 14/8/20

Đơn giản như thế này:
=Code2Str(B4)

JavaScript:

Function ChrW(I As Long) As String
  ChrW = Application.WorksheetFunction.Unichar(i)
  'ChrW = VBA.ChrW(i)
End Function
Function Code2Str(Str As String) As String
  Code2Str = Application.Evaluate(Str)
End Function

AnhThu-1976 · 15/8/20

Em có áp dụng các UDF ở các bài 3, 4, 5 nhưng kết quả là #Value! (tại các cột E, F, G trong file đính kèm của em), em không biết mình áp dụng bị sai chỗ nào, nhờ các anh hướng dẫn
Em cảm ơn!

huuthang_bd · 15/8/20

AnhThu-1976 đã viết:
Em có áp dụng các UDF ở các bài 3, 4, 5 nhưng kết quả là #Value! (tại các cột E, F, G trong file đính kèm của em), em không biết mình áp dụng bị sai chỗ nào, nhờ các anh hướng dẫn
Em cảm ơn!

Code của tôi ban sửa ChrW$ thành VBA.ChrW$
Bài #4 bạn sửa ChrW thành VBA.ChrW
Code bài #4 sẽ xóa hết ký tư & và " trong chuỗi (Ví dụ "A & B") hoặc có trường hợp chuyển nhầm nội dung không cần thiết (Ví dụ "ChrW$(7913)").

AnhThu-1976 · 15/8/20

huuthang_bd đã viết:
Code của tôi ban sửa ChrW$ thành VBA.ChrW$

Em đã sửa trong code của anh, nhưng nó cũng chưa ra kết quả mà nó ra ... (anh xem cột E)Em cảm ơn

huuthang_bd · 15/8/20

AnhThu-1976 đã viết:
Em đã sửa trong code của anh, nhưng nó cũng chưa ra kết quả mà nó ra ... (anh xem cột E)Em cảm ơn

Bạn copy code đã sửa lên tôi xem thử.

AnhThu-1976 · 15/8/20

huuthang_bd đã viết:
Bạn copy code đã sửa lên tôi xem thử.

Đây anh

Mã:

Function GPE(ByVal sStr As String) As String
Dim Arr As Variant, i As Long
Arr = Split(sStr, "&")
For i = LBound(Arr, 1) To UBound(Arr)
    If (Len(Arr(i)) - Len(Replace(Arr(i), """", ""))) Mod 2 = 1 Then
        Arr(i + 1) = Arr(i) & "&" & Arr(i + 1)
        Arr(i) = ""
    ElseIf Left(Arr(i), 5) = "VBA.ChrW$" Then
        Arr(i) = VBA.ChrW$(CLng(Mid(Arr(i), 7, Len(Arr(i)) - 7)))
    Else
        Arr(i) = Replace(Arr(i), """""", """")
        Arr(i) = Mid(Arr(i), 2, Len(Arr(i)) - 2)
    End If
Next
GPE = Join(Arr, "")
End Function

huuthang_bd · 15/8/20

Không phải vậy. Mấy chữ trong ngoặc kép thì đừng sửa chứ. Sửa như vầy mới đúng.

Mã:

Function GPE(ByVal sStr As String) As String
Dim Arr As Variant, i As Long
Arr = Split(sStr, "&")
For i = LBound(Arr, 1) To UBound(Arr)
    If (Len(Arr(i)) - Len(Replace(Arr(i), """", ""))) Mod 2 = 1 Then
        Arr(i + 1) = Arr(i) & "&" & Arr(i + 1)
        Arr(i) = ""
    ElseIf Left(Arr(i), 5) = "ChrW$" Then
        Arr(i) = VBA.ChrW$(CLng(Mid(Arr(i), 7, Len(Arr(i)) - 7)))
    Else
        Arr(i) = Replace(Arr(i), """""", """")
        Arr(i) = Mid(Arr(i), 2, Len(Arr(i)) - 2)
    End If
Next
GPE = Join(Arr, "")
End Function

AnhThu-1976 · 15/8/20

huuthang_bd đã viết:
Không phải vậy. Mấy chữ trong ngoặc kép thì đừng sửa chứ. Sửa như vầy mới đúng.

Trước đây em có sử dụng UDF "Univba" này

Mã:

Function UniVba(TxtUni As String) As String
    If TxtUni = "" Then
        UniVba = """"""
    Else
        TxtUni = TxtUni & " "
        If AscW(Left(TxtUni, 1)) < 256 Then UniVba = """"
        For n = 1 To Len(TxtUni) - 1
            uni1 = Mid(TxtUni, n, 1)
            uni2 = AscW(Mid(TxtUni, n + 1, 1))
            If AscW(uni1) > 255 And uni2 > 255 Then
                UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & "
            ElseIf AscW(uni1) > 255 And uni2 < 256 Then
                UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & """
            ElseIf AscW(uni1) < 256 And uni2 > 255 Then
                UniVba = UniVba & uni1 & """ & "
            Else
                UniVba = UniVba & uni1
            End If
        Next
        If Right(UniVba, 4) = " & """ Then
            UniVba = Mid(UniVba, 1, Len(UniVba) - 4)
        Else
            UniVba = UniVba & """"
        End If
    End If
End Function

Nay áp dụng dùng UDF của anh để chuyển ngược lại nhưng vẫn không ra kết quả
Không biết UDF "Univba" này có vấn đề gì không? Em áp dụng ở dòng thú 5 và 6 trong file đính kèm.
P/s: UDF "Univba" cái này không phải do em viết.
Em cảm ơn!

HeSanbi · 15/8/20

AnhThu-1976 đã viết:
Em đã sửa trong code của anh, nhưng nó cũng chưa ra kết quả mà nó ra ... (anh xem cột E)Em cảm ơn

Tốt nhất là viết thế này:

JavaScript:

Function Code2Str(Str As String) As String
  Str = VBA.Replace(Str, "strings.", "", , , 1)
  Str = VBA.Replace(Str, "vba.", "", , , 1)
  Str = VBA.Replace(Str, "chrw(", "Unichar(", , , 1)
  Str = VBA.Replace(Str, "chrw$(", "Unichar(", , , 1)
  Str = VBA.Replace(Str, "chr(", "Unichar(", , , 1)
  Str = VBA.Replace(Str, "chr$(", "Unichar(", , , 1)
  Code2Str = Application.Evaluate(Str)
End Function

huuthang_bd · 15/8/20

AnhThu-1976 đã viết:
Trước đây em có sử dụng UDF "Univba" này

Mã:

Function UniVba(TxtUni As String) As String If TxtUni = "" Then UniVba = """""" Else TxtUni = TxtUni & " " If AscW(Left(TxtUni, 1)) < 256 Then UniVba = """" For n = 1 To Len(TxtUni) - 1 uni1 = Mid(TxtUni, n, 1) uni2 = AscW(Mid(TxtUni, n + 1, 1)) If AscW(uni1) > 255 And uni2 > 255 Then UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & " ElseIf AscW(uni1) > 255 And uni2 < 256 Then UniVba = UniVba & "ChrW(" & AscW(uni1) & ") & """ ElseIf AscW(uni1) < 256 And uni2 > 255 Then UniVba = UniVba & uni1 & """ & " Else UniVba = UniVba & uni1 End If Next If Right(UniVba, 4) = " & """ Then UniVba = Mid(UniVba, 1, Len(UniVba) - 4) Else UniVba = UniVba & """" End If End If End Function

Nay áp dụng dùng UDF của anh để chuyển ngược lại nhưng vẫn không ra kết quả
Không biết UDF "Univba" này có vấn đề gì không? Em áp dụng ở dòng thú 5 và 6 trong file đính kèm.
P/s: UDF "Univba" cái này không phải do em viết.
Em cảm ơn!

Mã:

Function GPE(ByVal sStr As String) As String
Dim Arr As Variant, i As Long
Arr = Split(sStr, "&")
For i = LBound(Arr, 1) To UBound(Arr)
    If (Len(Arr(i)) - Len(Replace(Arr(i), """", ""))) Mod 2 = 1 Then
        Arr(i + 1) = Arr(i) & "&" & Arr(i + 1)
        Arr(i) = ""
    ElseIf Left(Arr(i), 4) = "ChrW" Then
        Arr(i) = ChrW(CLng(Mid(Left(Arr(i), Len(Arr(i)) - 1) , InStr(Arr(i), "(") + 1)))
    Else
        Arr(i) = Replace(Arr(i), """""", """")
        Arr(i) = Mid(Arr(i), 2, Len(Arr(i)) - 2)
    End If
Next
GPE = Join(Arr, "")
End Function

huuthang_bd · 17/8/20

Hôm trước là cuối tuần, tôi chỉ sửa chay trên điện thoại, không chạy thử nên kết quả không đúng. Hôm nay mới chạy thử được.

Mã:

Function GPE(ByVal sStr As String) As String
Dim Arr As Variant, i As Long
Arr = Split(sStr, "&")
For i = LBound(Arr, 1) To UBound(Arr)
    If (Len(Arr(i)) - Len(Replace(Arr(i), """", ""))) Mod 2 = 1 Then
        Arr(i + 1) = Arr(i) & "&" & Arr(i + 1)
        Arr(i) = ""
    Else
        Arr(i) = Trim(Arr(i))
        If Left(Trim(Arr(i)), 4) = "ChrW" Then
            Arr(i) = ChrW(CLng(Mid(Left(Arr(i), Len(Arr(i)) - 1), InStr(Arr(i), "(") + 1)))
        Else
            Arr(i) = Mid(Arr(i), 2, Len(Arr(i)) - 2)
            Arr(i) = Replace(Arr(i), """""", """")
        End If
    End If
Next
GPE = Join(Arr, "")
End Function

Nhờ giúp chuyển chữ dạng ký hiệu sang chữ bình thường (1 người xem)

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

hung2412

Thành viên tích cực

File đính kèm

huuthang_bd

Chuyên gia GPE

huuthang_bd

Chuyên gia GPE

Phuocam

Thành viên mới

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

AnhThu-1976

Thành viên tích cực

File đính kèm

huuthang_bd

Chuyên gia GPE

AnhThu-1976

Thành viên tích cực

File đính kèm

huuthang_bd

Chuyên gia GPE

AnhThu-1976

Thành viên tích cực

huuthang_bd

Chuyên gia GPE

AnhThu-1976

Thành viên tích cực

File đính kèm

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

huuthang_bd

Chuyên gia GPE

huuthang_bd

Chuyên gia GPE

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian