VNiTelex v1.2 - Hàm mã hóa giải mã chuỗi Unicode và Tiếng Việt cho mã VBA

HeSanbi · 5/7/23

Hôm nay tôi lại chia sẻ cho các bạn một hàm mã hóa chuỗi Unicode Tiếng Việt để dễ dàng viết chuỗi tiếng Việt vào trong VBA với kiểu gõ Telex đặc trưng của người Việt.

Lý do tại sao lại mã hóa? là vì trong VBA chỉ hỗ trợ lưu mã với một dạng mã hóa nhất định không hỗ trợ ký tự Unicode, nên cần phải chuyển mã thành mã phù hợp. Tuy nhiên việc gõ unicode trong mã VBA là rất rối, sinh mã dài. Mã hóa cũng giúp ngăn chặn xảy lỗi khi biên dịch hoặc thông dịch. Ngăn lỗi xảy ra tại hệ thống máy tính. Mã hóa cũng giúp tương thích với các kiểu dữ liệu khác như Json, javascript, hoặc python, ... . Nên việc mã hóa là rất cần thiết.

Dưới đây là hướng dẫn chi tiết.

Hàm VNiTelex - Mã hóa chuỗi Unicode tiếng Việt thành chuỗi trong VBA

Hàm này sẽ mã hóa tiếng Việt thành chuỗi của kiểu gõ Telex, và mã hóa các ký tự unicode khác thành chuỗi tương tự mã hóa trong Javascript là \uXXXX, hàm mã hóa này mã hóa tất cả ký tự Unicode có hỗ trợ.

Mã hóa Telex khác với cách gõ tay: Các ký tự thêm dấu (a, e o, w) và các ký tự xác định dấu (s, f, x, r, j) sẽ nằm sau cùng của từ và có dấu chấm phân tách. Ký tự xuống dòng sẽ mã hóa thành \n.

Ví dụ: với từ "ngừng" mã hóa thành "ngung.wf", phím thêm dấu "wf" phải nằm sau cùng và sau dấu chấm (.). Cách mã hóa này giúp dễ đọc chuỗi.

Ví dụ: với chuỗi "Xin chào cả gia đình" sẽ được mã hóa thành "Xin chao.f ca.r gia ddinh.f"

Sử dụng hàm đơn giản VNiTelex("chuỗi")

Mã hóa giải mã Unicode Hàn, Trung, Nga, Nhật, Ả-Rập, .... thành định dạng \uXXXX

나나 : 안녕하세요? 저는 나나예요.
Xin chào : Tôi là nana
마이클 : 안녕하세요? 저는 마이클 이에요.
Xin chào. Tồi là 마이클
나나 : 만나서 반가워요, 마이클 씨.
Rất vui được gặp bạn 마이클 씨..
마이클 : 반가워요. 나나 씨는 어느 나라 사람 이에요?
Rất vui được gặp. nana là người nước nào vậy?
나 나 : 저는 중국 사람 이에요.
Tôi là người Trung Quốc

1. 请进！Qǐng jìn! Mời vào!
2. 你家真干净。
Nǐ jiā zhēn gānjìng.
Nhà bạn thật sạch sẽ.
3. 你坐这儿吧。
Nǐ zuò zhèr ba.
Bạn ngồi xuống đây đi.
4. 你们太客气了。
Nǐmen tài kèqìle.
Các bạn khách sáo quá.
5. 你喝什么？茶还是果汁？
Nǐ hē shénme? Chá háishì guǒzhī?
Bạn uống gì? Trà hay nước hoa quả?

Xin chào Привет! (Privet)
Chào buổi sáng Доброе утро! (Dobroe utro)
Chào buổi chiều Добрый день!
Chào buổi tối Добрый вечер!
Chúc ngủ ngon Спокойной ночи!
Tên của bạn là gì? Как вас зовут?

Xin chào‫مرحبً!‬
Xin chào‫مرحبًا! / نهارك سع!
Khỏe không? ‫كبف الحال؟ / كيف حالك؟‬
Bạn từ châu Âu đến à? ‫هل أنت من أوروبا؟‬
Bạn từ châu Mỹ đến à? ‫هل أنت من أمريكا؟‬

Hàm VNiTelexDecode - Giải mã chuỗi mã hóa chuỗi Unicode Telex

Hàm giải mã chuỗi mã hóa Telex và unicode

Ví dụ: VNiTelexDecode("Xin chao.f ca.r gia ddinh.f")

Nếu không muốn mã hóa một đoạn trong chuỗi hãy sử dụng Đóng mở chuỗi như sau:

Hãy thêm khối mở {/ và đóng /} vào chuỗi nhập:

Ví dụ: VNiTelex("Xin chào cả {/gia đình/}") Thì chuỗi "gia đình" sẽ được loại trừ.

Ví dụ: VNiTelexDecode("{/Xin chao.f/} ca.r gia ddinh.f") Thì chuỗi "Xin chao.f" sẽ được loại trừ.

Hàm VNiEscape - Mã hóa chuỗi Unicode javascript

Hàm mã hóa unicode thành định dạng \uXXXX

Ví dụ: VNiEscape("Chuỗi unicode")

Thay vì mã hóa Telex như trên, hãy sử dụng hàm VNiEscape để mã hóa toàn bộ chuỗi unicode thành mã hóa đặc trưng của Json, javascript, python

Hàm VNiUnEscape - Giải mã chuỗi mã hóa chuỗi Unicode javascript

Hàm giải mã chuỗi mã hóa Telex và unicode

Ví dụ: VNiUnEscape ("Xin ch\u00E0o c\u1EA3 gia \u0111\u00ECnh")

Các bạn tham khảo thêm hàm MsgBox tiếng Việt có hỗ trợ hàm VNiTelex

MsgBox và InputBox v3.22: tiếng Việt, nhập ẩn, đếm ngược, bảng dữ liệu (Excel, Word, Access, PowerPoint)

**** Dự kiến: bản tiếp sẽ cho phép thêm ảnh, checkBox, ComboBox vào MsgBox và InputBox. ---------------------------------------------------------- Thêm kiểu nhập thông báo và tiêu đề tiếng Việt với mã Telex, giúp nhập tiếng Việt nhanh hơn mà không cần phải mã hóa chuỗi. Với tham số...

www.giaiphapexcel.com

Các bạn muốn mã hóa và chuyển mã trong VBA nhanh chóng có thể tham khảo tool hỗ trợ lập trình VBA:

VBA_FastCode - Học và viết code VBA một cách nhanh nhất

***** CẬP NHẬT BẢN THỬ NGHIỆM MỚI ***** Bản dành cho tất cả mọi người (bản thử nghiệm) (Bản trước đó chỉ dành riêng cho Developer) Link tải tại diễn đàn: https://www.giaiphapexcel.com/diendan/attachments/vba_fastcode-new-xlam.275891/ Phương pháp tìm nhập mới của Add-in, siêu nhanh giúp các bạn...

giaiphapexcel.com

Các bạn có thể đọc thêm các bài viết của tôi tại tag #sanbi udf

Mã tham khảo:

JavaScript:

Function VNiTelex(ByVal Text As String, Optional oregex___ As Object, Optional odi___ As Object, Optional ByVal floor___%) As String
  Dim di2, m, ms, m0$, m1, m2$, m3$, aF, iba%
  If odi___ Is Nothing Then
    Text = Replace$(Text, ChrW(272), "Dd"): Text = Replace$(Text, ChrW(273), "dd")
    Set odi___ = CreateObject("Scripting.Dictionary"): odi___.CompareMode = 0
    ' Các Phuò âm ghép
    '"(?:ngh|qu|tr|ch|th|nh|ng|ph|gi|kh|gh|r|t|s|d|h|l|x|c|v|b|n|m|[\u0111])"
    'AI, AO, AU, ÂU, AY, ÂY, EO, ÊU, IA, IÊU, YÊU, IU, OI, ÔI, ÕI, OAI, OAO, OAY, OEO, ÝA, UI, ÝI, ÝU, UÕ, UAI, UÂY, UÔI, ÝÕI, ÝÕU, UYA, UYU
    Dim ba1, ba2, angg, pat1, pat2
    pat1 = Array("a", "a", "a", "e", "e", "i", "o", "o", "o", "u", "u", "y")
    pat2 = Array("", "w", "a", "", "e", "", "", "o", "w", "", "w", "")
    ba1 = Array(Array(0, 259, 226, 0, 234, 0, 0, 244, 417, 0, 432, 0), _
                Array(225, 7855, 7845, 233, 7871, 237, 243, 7889, 7899, 250, 7913, 253), _
                Array(224, 7857, 7847, 232, 7873, 236, 242, 7891, 7901, 249, 7915, 7923), _
                Array(7843, 7859, 7849, 7867, 7875, 7881, 7887, 7893, 7903, 7911, 7917, 7927), _
                Array(227, 7861, 7851, 7869, 7877, 297, 245, 7895, 7905, 361, 7919, 7929), _
                Array(7841, 7863, 7853, 7865, 7879, 7883, 7885, 7897, 7907, 7909, 7921, 7925))
    ba2 = Array("", "s", "f", "r", "x", "j")
    For iba = 0 To 5:
      angg = ba1(iba)
      For m = 0 To 11:
        If angg(m) > 0 Then
          m0 = ChrW$(angg(m))
          odi___.Add m0, Array(pat1(m), pat2(m), ba2(iba))
          odi___.Add UCase$(m0), Array(UCase$(pat1(m)), pat2(m), ba2(iba))
        End If
      Next
    Next
    odi___.Add "scrt", CreateObject("Scripting.Dictionary"): Set di2 = odi___("scrt")
  Else
    Set di2 = odi___("scrt"): If floor___ = 0 And di2.count Then di2.RemoveAll
  End If
  If oregex___ Is Nothing Then
    Set oregex___ = CreateObject("VBScript.RegExp")
    With oregex___:  .Global = True: .IgnoreCase = -1: .MultiLine = -1
      Dim mpVowel$
      mpVowel = "\u1EC7\u00C0-\u00C3\u00C8-\u00CA\u00CC\u00CD\u00D2-\u00D5\u00D9\u00DA\u00DD\u00E0-\u00E3\u00E8-\u00EA\u00EC\u00ED\u00F2-\u00F5\u00F9\u00FA\u00FD\u0102\u0103\u0128\u0129\u0168\u0169\u01A0\u01A1\u01AF\u01B0\u1EA0-\u1EF9" '\u0110\u0111
      .Pattern = "(([\u01B0]?[" & mpVowel & "])(ch|ng|nh|t|c|n|m|a|i|o|u|y|[\u01A0]|))"
    End With
  End If
  Set ms = oregex___.Execute(Text)
  If ms.count Then
    iba = 2:
l:
    For Each m1 In ms
      If Not di2.Exists(m1) Then
        m3 = m1.SubMatches(2)
        If Len(m3) = iba Then
          di2.Add m1, "":  m2 = m1.SubMatches(1):
          If Len(m2) = 2 Then
            m0 = odi___(Left$(m2, 1))(0): aF = odi___(Right$(m2, 1))
          Else
            m0 = "": aF = odi___(m2)
          End If
          Text = Replace$(Text, m1, m0 & aF(0) & m3 & "." & aF(1) & aF(2))
        End If
      End If
    Next
    If iba > 0 Then iba = iba - 1: GoTo l
  End If

  VNiTelex = VNiEscape(Text)
End Function
Sub VNiTelex_test()
  VNiTelexDecode_test
End Sub


Function VNiTelexDecode(ByVal Text As String, Optional oregex___ As Object, Optional odi___ As Object) As String
  Dim l&: l = Len(Text): If l = 0 Then Exit Function
  Dim di2, x$, m, ms, m0$, m1$, m2$, m3$, m4, ba1, iba%, angg, re, v$, z$, ms2, m_, i1&, i2&, i3&
  Set re = CreateObject("VBScript.RegExp")
  With re:  .Global = -1: .IgnoreCase = -1: .MultiLine = -1
    .Pattern = "(^|[^\\]?)\{/([^\u0008]*?)/\}"
  End With

  Set odi___ = CreateObject("Scripting.Dictionary"): odi___.CompareMode = 1
  ' Các Phuò âm ghép
  '"(?:\b|[:_])(?:ngh|tr|ch|th|nh|ng|gi|qu|ph|kh|gh|r|t|s|d|h|l|x|c|v|b|n|m|[\u0111])"
  'AI, AO, AU, ÂU, AY, ÂY, EO, ÊU, IA, IÊU, YÊU, IU, OI, ÔI, ÕI, OAI, OAO, OAY, OEO, ÝA, UI, ÝI, ÝU, UÕ, UAI, UÂY, UÔI, ÝÕI, ÝÕU, UYA, UYU
  angg = Array("a", "aw", "aa", "e", "ee", "i", "o", "oo", "ow", "u", "uw", "y")
 
  For m = 0 To 11: odi___.Add angg(m), m: Next
  ba1 = Array(Array(0, 259, 226, 0, 234, 0, 0, 244, 417, 0, 432, 0), _
              Array(225, 7855, 7845, 233, 7871, 237, 243, 7889, 7899, 250, 7913, 253), _
              Array(224, 7857, 7847, 232, 7873, 236, 242, 7891, 7901, 249, 7915, 7923), _
              Array(7843, 7859, 7849, 7867, 7875, 7881, 7887, 7893, 7903, 7911, 7917, 7927), _
              Array(227, 7861, 7851, 7869, 7877, 297, 245, 7895, 7905, 361, 7919, 7929), _
              Array(7841, 7863, 7853, 7865, 7879, 7883, 7885, 7897, 7907, 7909, 7921, 7925))
  For iba = 0 To 5:
    angg = ba1(iba)
    For m = 0 To 11:
      If angg(m) > 0 Then ba1(iba)(m) = ChrW$(angg(m)) Else ba1(iba)(m) = ""
    Next
  Next
  Set di2 = CreateObject("Scripting.Dictionary"): di2.CompareMode = 0


  Set oregex___ = CreateObject("VBScript.RegExp")
  With oregex___:  .Global = True: .IgnoreCase = True: .MultiLine = True
    .Pattern = "((qu|gi|uo|[aeiouy])(ch|ng|nh|t|c|n|m|p|a|i|o|u|y|)\.([aweo][sfrxj]|[aweo]|[sfrxj]))"
  End With
 
  Set ms2 = re.Execute(Text)
  If ms2.count Then
    i1 = 1
    For Each m_ In ms2
      v = m_.SubMatches(0)
      If v = Empty Then i2 = 1 Else i2 = 2
      i3 = m_.FirstIndex + i2
      If i3 > i1 Then
        v = Mid$(Text, i1, i3 - i1)
        GoSub r: z = z & v & m_.SubMatches(1)
      Else
        z = z & m_.SubMatches(1)
      End If
      i1 = m_.FirstIndex + m_.Length + 1
    Next
    If i1 <= l Then v = Mid$(Text, i1): GoSub r: z = z & v
  Else
    v = Text: GoSub r: z = v
  End If
  VNiTelexDecode = z
Exit Function
r:

  If di2.count Then di2.RemoveAll
  v = VNiUnescape(v)
  v = Replace(Replace(v, "dd", ChrW$(273)), "Dd", ChrW$(272))

  Set ms = oregex___.Execute(v)
  If ms.count = 0 Then Return
  iba = 2
l:
  For Each m In ms
    x = m
    If Not di2.Exists(x) Then
      m1 = m.SubMatches(1)
      m2 = m.SubMatches(2)
      m3 = m.SubMatches(3)
      If StrComp(m1, "gi", 1) = 0 Then
        If m2 Like "[aiouyAIOUY]" Then
          m0 = m1: m1 = m2: m2 = ""
        Else
          m0 = Left$(m1, 1): m1 = Right$(m1, 1)
        End If
      ElseIf StrComp(m1, "qu", 1) = 0 Then
        m0 = m1: m1 = m2: m2 = ""
      ElseIf StrComp(m1, "uo", 1) = 0 Then
        If m3 Like "[wW]*" Then
          If m2 = Empty Then m0 = Left$(m1, 1) Else m0 = ChrW$(432 + (m1 Like "U*"))
        Else
          m0 = Left$(m1, 1)
        End If
        m1 = Right$(m1, 1)
      Else
        m0 = ""
      End If
      If m3 Like "[aAwWeEoO]*" Then m4 = m1 & Left$(m3, 1) Else m4 = m1
      If Len(m3) = iba Then
        di2.Add x, x:
        Select Case Right$(m3, 1)
        Case "s", "S": angg = ba1(1)
        Case "f", "F": angg = ba1(2)
        Case "r", "R": angg = ba1(3)
        Case "x", "X": angg = ba1(4)
        Case "j", "J": angg = ba1(5)
        Case Else: angg = ba1(0)
        End Select
        If UCase$(m1) <> m1 Then m2 = angg(odi___(m4)) & m2 Else m2 = UCase$(angg(odi___(m4))) & m2
        v = Replace$(v, x, m0 & m2)
      End If
    End If
  Next
  If iba > 0 Then iba = iba - 1: GoTo l
Return
End Function

Function VNiUnescape(ByVal str$, Optional RegEx As Object, Optional oDictionary As Object)
  Dim m, s$, t$

  str = Replace$(str, "\\", vbBack & "{-}" & vbBack)
  str = Replace$(str, "\""", """")
  str = Replace$(str, "\/", "/")
  str = Replace$(str, "\b", vbBack)
  str = Replace$(str, "\f", vbFormFeed)
  str = Replace$(str, "\n", vbLf)
  str = Replace$(str, "\r", vbCr)
  str = Replace$(str, "\t", vbTab)
  If RegEx Is Nothing Then
    Set RegEx = CreateObject("VBScript.RegExp")
    With RegEx: .Global = True: .IgnoreCase = True: .MultiLine = True
      .Pattern = "\\u([0-9a-fA-F]{4})"
    End With
  End If
  If oDictionary Is Nothing Then
    Set oDictionary = CreateObject("Scripting.Dictionary")
  Else
    If oDictionary.count Then oDictionary.RemoveAll
  End If
  For Each m In RegEx.Execute(str)
    s = m: t = m.SubMatches(0):
    If Not oDictionary.Exists(t) Then
      oDictionary.Add t, ""
      str = Replace$(str, "\u" & t, ChrW$(val("&H" & t)), , , 1)
    End If
  Next m
  str = Replace$(str, vbBack & "{-}" & vbBack, "\")
  VNiUnescape = str
End Function

Function VNiEscape(ByVal str$) As String
  Dim m, s$, t$, i&, k&, a&, h$, RE
  Set RE = CreateObject("VBScript.RegExp")
  With RE
    .Global = True: .IgnoreCase = False: .MultiLine = True
    .Pattern = "(.)(?=.*\1)"
    s = .Replace(str, "")
  End With
 
  str = Replace$(str, "\", "\\")
  For i = 1 To Len(s)
    t = Mid$(s, i, 1): a = AscW(t)
    Select Case a
    Case 1 To 127:
    Case Else: If (a < 0) Then a = 65536 + a
      h = Hex(a): h = "\u" & String(4 - Len(h), "0") & h
      str = Replace$(str, t, h)
    End Select
  Next

  str = Replace$(str, """", """""")
  str = Replace$(str, "/", "\/")
  str = Replace$(str, vbBack, "\b")
  str = Replace$(str, vbFormFeed, "\f")
  str = Replace$(str, vbLf, "\n")
  str = Replace$(str, vbCr, "\r")
  str = Replace$(str, vbTab, "\t")
  VNiEscape = str

End Function

HeSanbi · 24/7/23

***** Cập nhật v1.2 *****

Nếu không muốn mã hóa một đoạn trong chuỗi hãy sử dụng Đóng mở chuỗi như sau:

Hãy thêm khối mở {/ và đóng /} vào chuỗi nhập:

Ví dụ: VNiTelex("Xin chào cả {/gia đình/}") Thì chuỗi "gia đình" sẽ được loại trừ.

Ví dụ: VNiTelexDecode("{/Xin chao.f/} ca.r gia ddinh.f") Thì chuỗi "Xin chao.f" sẽ được loại trừ.

VNiTelex v1.2 - Hàm mã hóa giải mã chuỗi Unicode và Tiếng Việt cho mã VBA

HeSanbi

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

MsgBox và InputBox v3.22: tiếng Việt, nhập ẩn, đếm ngược, bảng dữ liệu (Excel, Word, Access, PowerPoint)

VBA_FastCode - Học và viết code VBA một cách nhanh nhất

File đính kèm

HeSanbi

HeSanbi

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

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

Facebook

Group

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