Chuyển mã Tiếng Việt, thay thế Unikey Toolkit (Hơn 17 kiểu mã)

Chia sẻ bởi:hands

★★★★★

‹ Add-in FormulaBeautifyXL: Phân tích công thức Excel... Tính tỷ lệ sở hữu các cá... ›

Quảng cáo

Hôm nay tôi lại chia sẻ cho các bạn một đoạn code giúp các bạn có thể chuyển các bảng mã Tiếng Việt với nhau.
Thực ra là một ứng dụng được viết giữa chừng của tôi. Nhưng khi viết mã tôi cảm thấy cảm hứng không còn nữa, và dừng giữa chừng, nên đành chia sẻ để các bạn có hứng thú thì phát triển thành ứng dụng chuyển mã Tiếng Việt.
Chứ nếu tôi cứ để trong kho, thì thật phí chất xám mà tôi đã đổ vào nó.

Code không chỉ có công dụng để chuyển mã, mà có thể ứng dụng vào việc tìm kiếm Tiếng Việt nếu các bạn muốn.
Nếu trong VBE của bạn đã đặt phông phù hợp với bảng mã nào đó thì các bạn có thể dùng code chuyển mã này để viết tiếng Việt trong VBE

Và code chuyển mã này có thể thay thế tốt với cách chuyển mã từ UniKey Toolkit

Với code chuyển mã thì có đến 19 kiểu mã:

Unicode Dựng sẵn
Unicode Tổ hợp
TCVN3
VISCII
VPS
BK-HCM 1
BK-HCM 2
Vietware F
Vietware X
VNI Windows
VNU
VIQR
UTF-8
Win-CP 1258
Hex Unicode
Decimal NCRs
Hex NCRs
Không dấu 1 (Không thể chuyển ngược lại)
Không dấu 2 (Không thể chuyển ngược lại)

Hàm chuyển mã – convertVNICode:

Call convertVNICode("chuỗi hoặc Range (vùng)", "Từ mã", "sang mã")

Các bạn có thể nhập mã chuyển là số thứ tự hoặc Tên mã trong Danh sách mã

Hàm tự động phát hiện mã – detectVNICode:

Call detectVNICode("chuỗi")

Hàm danh sách mã – ListVNICode

Nếu các bạn cài thêm Add-in Tool VBA cũng do tôi phát triển sẽ trợ giúp tốt trong việc code:
giaiphapexcel.com/diendan/threads/152720/

Nếu các bạn phát triển code mà có khó khăn gì cứ đăng câu hỏi ở bên dưới. Chúc các bạn thành công.

Hình ảnh mã tiếng Việt với phông thích hợp, nếu chuyển Add-in thành Book thì sẽ có:

543

Hình ảnh ứng dụng chuyển mã nếu hoàn thành:

544

Mã VBA:

' __   _____   _ ®
'   / / _ | / 
'    /| _ / / 
'   _/ |___/_/ _
'
Option Explicit

Private Sub convertVNICode_test()
  Dim UTF8 As Variant, Char As Variant, A As Variant, b As Variant

Char = VBA.Array(ChrW(7898), ChrW(7899), ChrW(7900), ChrW(7901), ChrW(7902), ChrW(7903), ChrW(7904), ChrW(7905), ChrW(7906), ChrW(7907), _
                   ChrW(7912), ChrW(7913), ChrW(7914), ChrW(7915), ChrW(7916), ChrW(7917), ChrW(7918), ChrW(7919), ChrW(7920), ChrW(7921), _
                   ChrW(416), ChrW(218), ChrW(250), ChrW(217), ChrW(249), ChrW(7910), ChrW(7911), ChrW(360), ChrW(361), ChrW(7908), ChrW(7909), _
                   ChrW(7922), ChrW(7923), ChrW(7926), ChrW(7927), ChrW(7928), ChrW(7929), ChrW(7924), ChrW(7925))

UTF8 = VBA.Array("Õì", "õì", "ÕÌ", "õÌ", "ÕÒ", "õÒ", "ÕÞ", "õÞ", "Õò", "õò", _
                   "Ýì", "ýì", "ÝÌ", "ýÌ", "ÝÒ", "ýÒ", "ÝÞ", "ýÞ", "Ýò", "ýò", _
                   "õ", "Õ", "YÌ", "yÌ", "YÒ", "yÒ", "YÞ", "yÞ", "Yò", "yò", "ã ý Ý õ Õ Yì yì ð")

Dim Text As String
  Text = VBA.Join(Char, " ")
  Text = convertVNICode(Text, 2, 14)
  Debug.Print Text
  Text = VBA.Join(UTF8, " ")
  Text = convertVNICode(Text, 14, 2)

'Debug.Print convertVNICode("R" & ChrW(7845) & "t vui " & ChrW(273) & "" & ChrW(432) & "" & ChrW(7907) & "c g" & ChrW(7863) & "p b" & ChrW(7841) & "n", _
                             2, 14)

End Sub
Private Sub convertVNICode_test2()
  Dim s$, i%, r As Range, RG As Range, ws As Excel.Worksheet
  Set ws = ActiveSheet
  Set RG = ws.Range("A2").Resize(6000)
  convertVNICode RG, constVniWin(), constUnicodeDS()
End Sub

Function convertVNICode(ByVal SourceInput, ByVal fromcode$, ByVal tocode$)
  If fromcode = tocode Then
    GoTo g
  End If
  On Error Resume Next
  Dim O, A, b, i, j, c, d, g, f, dt As Object, ds As Object, e As Boolean
  Select Case TypeName(SourceInput)
  Case "Range": Set O = SourceInput
  Case "String": O = SourceInput
  Case Else: Exit Function
  End Select
  A = fromcode
  b = tocode
  getVNICode A, b
  c = LBound(A): d = UBound(A)
  g = LBound(b): f = UBound(b)
  ' dt là các kyì týò câÌn thay thêì trýõìc các kyì týò khác
  ' ds là các kyì týò ðýõòc thay thêì có trùng viò trí khác
  Set dt = VBA.CreateObject("Scripting.Dictionary")
  Set ds = VBA.CreateObject("Scripting.Dictionary")
  ' Các trýõÌng hõòp có thêÒ xaÒy ra:
  '   1. Nêìu khác viò trí, có chung kyì týò.(CâÌn thay thêì sau cùng)
  '     VD: a, b, c, d, e
  '         b, h, j, l, k
  '   2. Nêìu týÌ bên này có chýìa kyì týò bên kia, có hai trýõÌng hõòp:
  '      + Kyì týò trùng ðýìng viò trí trýõìc (CâÌn thay thêì sau)
  '        VD: a, b, c, j, e
  '            g, h, aj, l, m
  '      + Kyì týò trùng ðýìng viò trí sau (CâÌn thay thêì sau)
  '        VD: a, b, c, d, e
  '            g, h, ja, l, m
  '   3. Nêìu hai kyì týò cùng viò trí, bãÌng nhau thiÌ không thay thêì.
  For j = g To f
    For i = c To d
      If A(i) = b(j) Then
        If i <> j Then
          ds(A(i)) = VBA.Array(i, j)
        End If
      ElseIf b(j) Like "*" & A(i) & "*" Then
        dt(A(i)) = VBA.Array(i, j)
      End If
    Next
  Next
  If IsObject(O) Then
    SpeedOn e
    For Each i In dt.items()
      O.Replace What:=A(i(1)), Replacement:=b(i(1)), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next
    For i = c To d
      If A(i) <> b(i) Then
        If Not (dt.exists(A(i)) Or ds.exists(A(i))) Then
          O.Replace What:=A(i), Replacement:=b(i), LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        End If
      End If
    Next
    For Each i In ds.items()
      O.Replace What:=A(i(1)), Replacement:=b(i(1)), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next
    SpeedOff e
  Else
    For Each i In dt.items()
      O = VBA.Replace(O, A(i(1)), b(i(1)))
    Next
    For i = c To d
      If A(i) <> b(i) Then
        If Not (dt.exists(A(i)) Or ds.exists(A(i))) Then
          O = VBA.Replace(O, A(i), b(i))
        End If
      End If
    Next
    For Each i In ds.items()
      O = VBA.Replace(O, A(i(1)), b(i(1)))
    Next
    convertVNICode = O
  End If

g:
  Set dt = Nothing
  Set ds = Nothing
  On Error GoTo 0
End Function

Private Sub detectVNICode_test()
  'Debug.Print detectVNICode(ChrW(7844) & " " & ChrW(7855))
  Debug.Print detectVNICode([A2:A1000])
  'Debug.Print convertVNICode([A2], detectVNICode([A2]), constUnicodeDS)
End Sub

Function detectVNICode(ByVal Source) As Integer
  On Error Resume Next

Dim r, t$, i, j, k%, A, m&, X%, s&, l&, l1&, l2%, key$
  Dim d As Object, D2 As Object
  Static z As Object
  Set d = priDictionary
  Set D2 = priDictionary
  If z Is Nothing Then
    Set z = VNICodes2
  End If
  Select Case TypeName(Source)
  Case "Range":
    For Each r In Source
      t = r.Value: GoSub detect
    Next
  Case "String":
    If Source = vbNullString Then
      Exit Function
    End If
    t = Source: GoSub detect
  End Select
  If d.Count Then
    For Each j In d.Keys()
      A = d(j)
      If A > m Then
        m = A: X = j
      End If
    Next
    detectVNICode = X
  End If
Exit Function
detect:
  l1 = Len(t)
  For Each j In z.Keys()
    l2 = Len(j)
    s = 1
r:
    l = InStr(s, t, j)
    If l Then
      For k = 0 To l2 - 1
        key = l + k
        If d.exists(key) Then
          s = l + l2: If s <= l1 Then GoTo r
        Else
          d.Add key, k
        End If
      Next
      D2.Add j, z(j)
    End If

N:
  Next
  d.RemoveAll
  For Each j In D2.Keys()
    For Each i In D2(j)
      key = i
      If d.exists(key) Then
        k = d(key) + 1
        d.Remove key
        d.Add key, k
      Else
        d.Add key, 1
      End If
    Next
  Next
Return
End Function
Private Function StandardizedForRE(ByVal Text$) As String
  Dim A, i%, sp$(), l&, s$
  For Each A In Array("", ".", "?", "+", "*", "(", ")", "[", "]", "{", "}", "^", "$")
    Text = Replace(Text, A, "" & A)
  Next
  sp = Split(Text, "/")
  For A = 0 To UBound(sp)
    l = Len(Text)
    For i = 1 To l
      s = Mid(sp(i), i, 1)
      Select Case AscW(s)
      Case Is <= 128:
      Case Else:
      End Select
    Next
  Next

End Function
Sub VNICodes2_test()
  Dim O, i
  Set O = VNICodes2
  For Each i In O.Keys()
    Debug.Print i
  Next
End Sub

Function VNICodes2() As Object
  On Error Resume Next
  Static d As Object
  If Not d Is Nothing Then GoTo e
  Dim z, i%, j%, v$, sp, A(), l1&, l2%
  Set d = priDictionary
  z = VNICodes
  For i = 2 To 15
    sp = Split(z(i), "/")
    For l1 = 3 To 1 Step -1
      For j = LBound(sp) To UBound(sp)
        v = sp(j)
        l2 = Len(v)
        If l2 = l1 Then
          If d.exists(v) Then
            A = d(v): d.Remove v
            ReDim Preserve A(UBound(A) + 1)
            A(UBound(A)) = i
            d.Add v, A
          Else
            d.Add v, Array(i)
          End If
        End If
N:
      Next
    Next
  Next
e:
  Set VNICodes2 = d
End Function
Private Function priDictionary()
  Set priDictionary = VBA.CreateObject("Scripting.Dictionary")
End Function

Function VNICodes()
'en.wikipedia.org/wiki/Byte_order_mark
  Const n_ = vbNullString
  Dim A$, b$, c$, d$, e$, f, g, H, i%, j%, z(18)
  A = ChrW(&H300): b = ChrW(&H301): c = ChrW(&H303): d = ChrW(&H309): e = ChrW(&H323)
  f = VBA.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, 7842, 195, 7840, 258, 7854, 7856, 7858, 7860, 7862, 194, 7844, 7846, 7848, 7850, 7852, 201, 200, 7866, 7868, 7864, 202, 7870, 7872, 7874, 7876, 7878, 205, 204, 7880, 296, 7882, 211, 210, 7886, 213, 7884, 212, 7888, 7890, 7892, 7894, 7896, 416, 7898, 7900, 7902, 7904, 7906, 218, 217, 7910, 360, 7908, 431, 7912, 7914, 7916, 7918, 7920, 221, 7922, 7926, 7928, 7924, 272)
  g = VBA.Array(97, 97, 97, 97, 97, 259, 259, 259, 259, 259, 259, 226, 226, 226, 226, 226, 226, 101, 101, 101, 101, 101, 234, 234, 234, 234, 234, 234, 105, 105, 105, 105, 105, 111, 111, 111, 111, 111, 244, 244, 244, 244, 244, 244, 417, 417, 417, 417, 417, 417, 117, 117, 117, 117, 117, 432, 432, 432, 432, 432, 432, 121, 121, 121, 121, 121, 273, 65, 65, 65, 65, 65, 258, 258, 258, 258, 258, 258, 194, 194, 194, 194, 194, 194, 69, 69, 69, 69, 69, 202, 202, 202, 202, 202, 202, 73, 73, 73, 73, 73, 79, 79, 79, 79, 79, 212, 212, 212, 212, 212, 212, 416, 416, 416, 416, 416, 416, 85, 85, 85, 85, 85, 431, 431, 431, 431, 431, 431, 89, 89, 89, 89, 89, 272)
  H = VBA.Array(b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_, b, A, d, c, e, b, A, d, c, e, n_)
UnicodeHex:  z(16) = f
DecimalNCRs:  z(17) = f
HexNCRs: z(18) = f
  For i = LBound(f) To UBound(f)
    A = Hex(f(i))
    A = String(4 - Len(A), "0") & A
    z(16)(i) = "u" & A
    z(17)(i) = "&#" & f(i) & ";"
    z(18)(i) = "&#x" & A & ";"
    f(i) = ChrW(f(i))
    g(i) = ChrW(g(i)) & H(i)
  Next
NotMask1____0: z(j) = "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/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/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/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"
NotMask2____1: j = j + 1: z(j) = "a/a/a/a/a/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/" & ChrW(259) & "/â/â/â/â/â/â/e/e/e/e/e/ê/ê/ê/ê/ê/ê/i/i/i/i/i/o/o/o/o/o/ô/ô/ô/ô/ô/ô/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/" & ChrW(417) & "/u/u/u/u/u/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/" & ChrW(432) & "/y/y/y/y/y/" & ChrW(273) & "/A/A/A/A/A/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/" & ChrW(258) & "/Â/Â/Â/Â/Â/Â/E/E/E/E/E/Ê/Ê/Ê/Ê/Ê/Ê/I/I/I/I/I/O/O/O/O/O/Ô/Ô/Ô/Ô/Ô/Ô/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/" & ChrW(416) & "/U/U/U/U/U/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/" & ChrW(431) & "/Y/Y/Y/Y/Y/" & ChrW(272)
UnicodeDS___2: j = j + 1: z(j) = Join(f, "/")
UnicodeTH___3: j = j + 1: z(j) = Join(g, "/")
TCVN3_______4: j = j + 1: z(j) = "¸/µ/¶/·/¹/¨/¾/»/¼/½/Æ/©/Ê/Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/ª/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/á/â/ä/«/è/å/æ/ç/é/¬/í/ê/ë/ì/î/ó/ï/ñ/ò/ô//ø/õ/ö/÷/ù/ý/ú/û/ü/þ/®/¸/µ/¶/·/¹/¡/¾/»/¼/½/Æ/¢/Ê/Ç/È/É/Ë/Ð/Ì/Î/Ï/Ñ/£/Õ/Ò/Ó/Ô/Ö/Ý/×/Ø/Ü/Þ/ã/ß/á/â/ä/¤/è/å/æ/ç/é/¥/í/ê/ë/ì/î/ó/ï/ñ/ò/ô/¦/ø/õ/ö/÷/ù/ý/ú/û/ü/þ/§"
VISCII______5: j = j + 1: z(j) = "á/à/ä/ã/Õ/å/¡/¢/Æ/Ç/£/â/¤/¥/¦/ç/§/é/è/ë/¨/©/ê/ª/«/¬//®/í/ì/ï/î/¸/ó/ò/ö/õ/÷/ô/¯/°/±/²/µ/½/¾/¶/·/Þ/þ/ú/ù/ü/û/ø/ß/Ñ/×/Ø/æ/ñ/ý/Ï/Ö/Û/Ü/ð/Á/À/Ä/Ã/€/Å//‚/Æ/Ç/ƒ/Â/„/…/†/ç/‡/É/È/Ë/ˆ/‰/Ê/Š/‹/Œ//Ž/Í/Ì/›/Î/˜/Ó/Ò/™/õ/š/Ô///'/'/"/´/•/–/—/³/"/Ú/Ù/œ//ž/¿/º/»/¼/ÿ/¹/Ý/Ÿ/Ö/Û/Ü/Ð"
VPS_________6: j = j + 1: z(j) = "á/à/ä/ã/å/æ/¡/¢/£/¤/¥/â/Ã/À/Ä/Å/Æ/é/è/È/ë/Ë/ê/‰/Š/‹/Í/Œ/í/ì/Ì/ï/Î/ó/ò/Õ/õ/†/ô/Ó/Ò/°/‡/¶/Ö/§/©/ª/«/®/ú/ù/û/Û/ø/Ü/Ù/Ø/º/»/¿/š/ÿ/›/Ï/œ/Ç/Á/€//‚/å/ˆ//Ž//ð/¥/Â/ƒ/„/…/Å/Æ/É/×/Þ/þ/Ë/Ê//"/"/•/Œ/´/µ/·/¸/Î/¹/¼/½/¾/†/Ô/–/—/˜/™/¶/÷//ž/Ÿ/¦/®/Ú/¨/Ñ/¬/ø/Ð//¯/±/»/¿/Ý/²/ý/³/œ/ñ"
BKHCM1______7: j = j + 1: z(j) = "¾/¿/À/Á/Â/×/Ø/Ù/Ú/Û/Ü/Ý/Þ/ß/à/á/â/Ã/Ä/Å/Æ/Ç/ã/ä/å/æ/ç/è/È/É/Ê/Ë/Ì/Í/Î/Ï/Ð/Ñ/é/ê/ë/ì/í/î/ï/ð/ñ/ò/ó/ô/Ò/Ó/Ô/Õ/Ö/õ/ö/÷/ø/ù/ú/û/ü/ý/þ/ÿ/½/€//‚/ƒ/„/™/š/›/œ//˜/Ÿ/~/¡/¢/£/¤/…/†/‡/ˆ/‰/¥/¦/§/¨/©/ª/Š/‹/Œ//Ž///'/'/"/«/¬//®/¯/°/±/²/³/´/µ/¶/"/•/–/—/˜/·/¸/¹/º/»/¼/{/^/`/|/Ž/}"
BKHCM2______8: j = j + 1: z(j) = "aá/aâ/aã/aä/aå/ù/ùæ/ùç/ùè/ùé/ùå/ê/êë/êì/êí/êî/êå/eá/eâ/eã/eä/eå/ï/ïë/ïì/ïí/ïî/ïå/ñ/ò/ó/ô/õ/oá/oâ/oã/oä/oå/ö/öë/öì/öí/öî/öå/ú/úá/úâ/úã/úä/úå/uá/uâ/uã/uä/uå/û/ûá/ûâ/ûã/ûä/ûå/yá/yâ/yã/yä/yå/à/AÁ/AÂ/AÃ/AÄ/AÅ/Ù/ÙÆ/ÙÇ/ÙÈ/ÙÉ/ÙÅ/Ê/ÊË/ÊÌ/ÊÍ/ÊÎ/ÊÅ/EÁ/EÂ/EÃ/EÄ/EÅ/Ï/ÏË/ÏÌ/ÏÍ/ÏÎ/Ïå/Ñ/Ò/Ó/Ô/Õ/OÁ/OÂ/OÃ/OÄ/OÅ/Ö/ÖË/ÖÌ/ÖÍ/ÖÎ/ÖÅ/Ú/ÚÁ/ÚÂ/ÚÃ/ÚÄ/ÚÅ/UÁ/UÂ/UÃ/UÄ/UÅ/Û/ÛÁ/ÛÂ/ÛÃ/ÛÄ/ÛÅ/YÁ/YÂ/YÃ/YÄ/YÅ/À"
VietwareF___9: j = j + 1: z(j) = "À/ª/¶/º/Á/Ÿ/Å/Â/Ã/Ä/Æ/¡/Ê/Ç/È/É/Ë/Ï/Ì/Í/Î/Ñ/£/Õ/Ò/Ó/Ô/Ö/Û/Ø/Ù/Ú/Ü/â/ß/à/á/ã/¤/ç/ä/å/æ/è/¥/ì/é/ê/ë/í/ò/î/ï/ñ/ó/§/÷/ô/õ/ö/ø/ü/ù/ú/û/ÿ/¢/À/ª/¶/º/Á/–/Å/Â/Ã/Ä/Æ/—/Ê/Ç/È/É/Ë/Ï/Ì/Í/Î/Ñ/™/Õ/Ò/Ó/Ô/Ö/Û/Ø/Ù/Ú/Ü/â/ß/à/á/ã/š/ç/ä/å/æ/è/›/ì/é/ê/ë/í/ò/î/ï/ñ/ó/œ/÷/ô/õ/ö/ø/ü/ù/ú/û/ÿ/˜"
VietwareX__10: j = j + 1: z(j) = "aï/aì/aí/aî/aû/à/àõ/àò/àó/àô/àû/á/áú/áö/áø/áù/áû/eï/eì/eí/eî/eû/ã/ãú/ãö/ãø/ãù/ãû/ê/ç/è/é/ë/oï/oì/oí/oî/oü/ä/äú/äö/äø/äù/äü/å/åï/åì/åí/åî/åü/uï/uì/uí/uî/uû/æ/æï/æì/æí/æî/æû/yï/yì/yí/yî/yñ/â/AÏ/AÌ/AÍ/AÎ/AÛ/À/ÀÕ/ÀÒ/ÀÓ/ÀÔ/ÀÛ/Á/ÁÚ/ÁÖ/ÁØ/ÁÙ/ÁÛ/EÏ/EÌ/EÍ/EÎ/EÛ/Ã/ÃÚ/ÃÖ/ÃØ/ÃÙ/ÃÛ/Ê/Ç/È/É/Ë/OÏ/OÌ/OÍ/OÎ/OÜ/Ä/ÄÚ/ÄÖ/ÄØ/ÄÙ/ÄÜ/Å/ÅÏ/ÅÌ/ÅÍ/ÅÎ/ÅÜ/UÏ/UÌ/UÍ/UÎ/UÛ/Æ/ÆÏ/ÆÌ/ÆÍ/ÆÎ/ÆÛ/YÏ/YÌ/YÍ/YÎ/YÑ/Â"
VniWin_____11: j = j + 1: z(j) = "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ä/í/ì/æ/ó/ò/où/oø/oû/oõ/oï/oâ/oá/oà/oå/oã/oä/ô/ôù/ôø/ôû/ôõ/ôï/uù/uø/uû/uõ/uï/ö/öù/öø/öû/öõ/öï/yù/yø/yû/yõ/î/ñ/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Ä/Í/Ì/Æ/Ó/Ò/OÙ/OØ/OÛ/OÕ/OÏ/OÂ/OÁ/OÀ/OÅ/OÃ/OÄ/Ô/ÔÙ/ÔØ/ÔÛ/ÔÕ/ÔÏ/UÙ/UØ/UÛ/UÕ/UÏ/Ö/ÖÙ/ÖØ/ÖÛ/ÖÕ/ÖÏ/YÙ/YØ/YÛ/YÕ/Î/Ñ"
VNU________12: j = j + 1: z(j) = "Ÿ/¡/¨/¬//¯/°/±/²/³/´/µ/¶/·/¸/¹/º/¾/¿/À/Á/Â/Å/Æ/Ë/Ì/Í/Î/Ï/Ö/×/Ø/Ù/Ü/Ý/Þ/ß/à/á/â/ã/ä/å/æ/ç/è/é/ê/ë/ì/î/ï/ð/ñ/ò/õ/ö/÷/ø/ù/ú/û/ü/ý/þ/ÿ/½/€/" & ChrW(129) & "/‚/Ã/" & ChrW(7840) & "/ƒ/" & ChrW(7854) & "/" & ChrW(7856) & "/" & ChrW(7858) & "/" & ChrW(7860) & "/" & ChrW(7862) & "/„/…/" & ChrW(7846) & "/" & ChrW(7848) & "/" & ChrW(6) & "/" & ChrW(7852) & "/É/È/" & ChrW(7866) & "/" & ChrW(7868) & "/" & ChrW(7864) & "/‰/" & ChrW(7870) & "/" & ChrW(7872) & "/" & ChrW(7874) & "/" & _
                                 ChrW(7876) & "/" & ChrW(7878) & "/Í/Ì/" & ChrW(7880) & "/" & ChrW(296) & "/" & ChrW(7882) & "/Œ/Ò/" & ChrW(7886) & "/Õ/" & ChrW(7884) & "/" & ChrW(141) & "/" & ChrW(7888) & "/" & ChrW(7890) & "/" & ChrW(7892) & "/" & ChrW(7894) & "/" & ChrW(7896) & "/" & ChrW(381) & "/" & ChrW(7898) & "/" & ChrW(7900) & "/" & ChrW(143) & "/" & ChrW(7904) & "/" & ChrW(7906) & "/˜/Ù/™/" & ChrW(360) & "/" & ChrW(7908) & "/œ/" & ChrW(157) & "/" & ChrW(7914) & "/" & ChrW(7916) & "/" & ChrW(7918) & "/" & ChrW(7920) & "/" & ChrW(382) & "/" & ChrW(7922) & "/" & ChrW(7926) & "/" & ChrW(7928) & "/" & ChrW(7924) & "/" & ChrW(272)
VIQR_______13: j = j + 1: z(j) = "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./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-/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./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./DD"
UTF8_______14: j = j + 1: z(j) = "Ã¡/Ã /áº£/Ã£/áº¡/Äƒ/áº¯/áº±/áº³/áºµ/áº·/Ã¢/áº¥/áº§/áº©/áº«/áº/Ã©/Ã¨/áº»/áº½/áº¹/Ãª/áº¿/á»/á»ƒ/á»…/á»‡/Ã/Ã¬/á»‰/Ä©/á»‹/Ã³/Ã²/á»/Ãµ/á»/Ã´/á»'/á»"/á»•/á»—/á»™/Æ¡/á»›/á»/á»Ÿ/á»¡/á»£/Ãº/Ã¹/á»§/Å©/á»¥/Æ°/á»©/á»«/á»/á»¯/á»±/Ã½/á»³/á»·/á»¹/á»µ/Ä'/Ã/Ã€/áº¢/Ãƒ/áº /Ä‚/áº®/áº°/áº²/áº´/áº¶/Ã‚/áº¤/áº¦/áº¨/áºª/áº¬/Ã‰/Ãˆ/áºº/áº¼/áº¸/ÃŠ/áº¾/á»€/á»‚/á»„/á»†/Ã/ÃŒ/á»ˆ/Ä¨/á»Š/Ã"/Ã'/á»Ž/Ã•/á»Œ/Ã"/á»/á»'/á»"/á»–/á»˜/Æ /á»š/á»œ/á»ž/á» /á»¢/Ãš/Ã™/á»¦/Å¨/á»¤/Æ¯/á»¨/á»ª/á»¬/á»®/á»°/Ã/á»²/á»¶/á»¸/á»´/Ä/"
WinCP1258__15: j = j + 1: z(j) = "á/à/aÒ/aÞ/aò/ã/ãì/ãÌ/ãÒ/ãÞ/ãò/â/âì/âÌ/âÒ/âÞ/âò/é/è/eÒ/eÞ/eò/ê/êì/êÌ/êÒ/êÞ/êò/í/iÌ/iÒ/iÞ/iò/ó/oÌ/oÒ/oÞ/oò/ô/ôì/ôÌ/ôÒ/ôÞ/ôò/õ/õì/õÌ/õÒ/õÞ/õò/ú/ù/uÒ/uÞ/uò/ý/ýì/ýÌ/ýÒ/ýÞ/ýò/yì/yÌ/yÒ/yÞ/yò/ð/Á/À/AÒ/AÞ/Aò/Ã/Ãì/ÃÌ/ÃÒ/ÃÞ/Ãò/Â/Âì/ÂÌ/ÂÒ/ÂÞ/Âò/É/È/EÒ/EÞ/Eò/Ê/Êì/ÊÌ/ÊÒ/ÊÞ/Êò/Í/IÌ/IÒ/IÞ/Iò/Ó/OÌ/OÒ/OÞ/Oò/Ô/Ôì/ÔÌ/ÔÒ/ÔÞ/Ôò/Õ/Õì/ÕÌ/ÕÒ/ÕÞ/Õò/Ú/Ù/UÒ/UÞ/Uò/Ý/Ýì/ÝÌ/ÝÒ/ÝÞ/Ýò/Yì/YÌ/YÒ/YÞ/Yò/Ð"

VNICodes = z
  Erase z
End Function

Function getVNICode(fromcode, tocode)
  Dim H, i, s, k%, z, l
  z = VNICodes
  l = ListVNICode

H = fromcode: GoSub g: fromcode = H
  H = tocode: GoSub g: tocode = H
Exit Function
g:
  For i = LBound(l) To UBound(l)
    If H = l(i) Then
      H = i
      Exit For
    End If
  Next
  H = Split(z(H), "/")
Return
End Function

Function ListVNICode()
  ListVNICode = VBA.Array("Kh" & ChrW(244) & "ng d" & ChrW(7845) & "u 1", "Kh" & ChrW(244) & "ng d" & ChrW(7845) & "u 2", "Unicode D" & ChrW(7921) & "ng s" & ChrW(7861) & "n", "Unicode T" & ChrW(7893) & " h" & ChrW(7907) & "p", "TCVN3", "VISCII", "VPS", "BK-HCM 1", "BK-HCM 2", "Vietware F", "Vietware X", "VNI Windows", "VNU", "VIQR", "UTF-8", "Win-CP 1258", "Hex Unicode", "Decimal NCRs", "Hex NCRs")
End Function

Function constNotMask1(): constNotMask1 = 0: End Function
Function constNotMask2(): constNotMask2 = 1: End Function
Function constUnicodeDS(): constUnicodeDS = 2: End Function
Function constUnicodeTH(): constUnicodeTH = 3: End Function
Function constTCVN3(): constTCVN3 = 4: End Function
Function constVISCII(): constVISCII = 5: End Function
Function constVPS(): constVPS = 6: End Function
Function constBKHCM1(): constBKHCM1 = 7: End Function
Function constBKHCM2(): constBKHCM2 = 8: End Function
Function constVietwareF(): constVietwareF = 9: End Function
Function constVietwareX(): constVietwareX = 10: End Function
Function constVniWin(): constVniWin = 11: End Function
Function constVNU(): constVNU = 12: End Function
Function constVIQR(): constVIQR = 13: End Function
Function constUTF8(): constUTF8 = 14: End Function
Function constWinCP1258(): constWinCP1258 = 15: End Function
Function constHexUnicode(): constHexUnicode = 16: End Function
Function constDecimalNCRs(): constDecimalNCRs = 17: End Function
Function constHexNCRs(): constHexNCRs = 18: End Function

Function DialogExplorer(Optional FolderPath$, _
                        Optional sDesc$ = "All File", _
                        Optional sFilter$ = "*.*", _
                        Optional title$ = "File Open", _
                        Optional FileDialog& = 1, _
                        Optional InitialView& = 2, _
                        Optional ButtonName$ = "&Select", _
                        Optional MultiSelect As Boolean = 0) As Variant
  DialogExplorer = ""
  Dim Arr(), k, it
  With Application.FileDialog(FileDialog) '1|4'
    If ButtonName <> vbNullString Then .ButtonName = ButtonName
'    If FolderPath <> vbNullString Then
'      .InitialFileName = FolderPath
'    Else
'      .InitialFileName = Application.DefaultFilePath
'    End If
    If FileDialog = 1 Then
      .Filters.Clear
      .Filters.Add sDesc, sFilter
      If sDesc$ <> "All File" Then .Filters.Add "All File", "*.*"
    End If
    If title <> vbNullString Then .title = title
    .InitialView = InitialView 'msoFileDialogViewDetails'
    .AllowMultiSelect = IIf(FileDialog = 4, False, MultiSelect)
    If .Show Then
      If FileDialog = 4 Then
        DialogExplorer = .SelectedItems(1)
      Else
        For Each it In .SelectedItems
          ReDim Preserve Arr(k): Arr(k) = it: k = k + 1
        Next it
        DialogExplorer = Arr
      End If
    End If
    If FileDialog = 1 Then .Filters.Clear
  End With
End Function

Sub SpeedOn(Optional turned As Boolean, _
              Optional Screen As Boolean = True, _
              Optional Events As Boolean = True, _
              Optional Calcula As Boolean = True)
  SetSpeedApp True, turned, Screen, Events, Calcula
End Sub
Sub SpeedOff(Optional turned As Boolean = True, _
              Optional Screen As Boolean = True, _
              Optional Events As Boolean = True, _
              Optional Calcula As Boolean = True)
  If Not turned Then
    SetSpeedApp False, turned, Screen, Events, Calcula
  End If
End Sub

Sub SetSpeedApp(Optional ByVal TurnOn As Boolean = False, _
              Optional turned As Boolean, _
              Optional Screen As Boolean = True, _
              Optional Events As Boolean = True, _
              Optional Calcula As Boolean = True)
  On Error Resume Next
  With Application
    turned = (.ScreenUpdating = False And Screen) _
          Or (.EnableEvents = False And Events) _
          Or (.Calculation = xlCalculationManual And Calcula)
    If TurnOn And Not turned Then
       If .ScreenUpdating And Screen Then .ScreenUpdating = False
       If .EnableEvents And Events Then .EnableEvents = False
       If .Calculation <> xlCalculationManual And Calcula Then .Calculation = xlCalculationManual
        '.CalculateBeforeSave = False
        '.DisplayAlerts = False
        '.Cursor = xlWait
        '.StatusBar = True
        '.EnableCancelKey = xlErrorHandler
    ElseIf Not TurnOn And turned Then
      If Not .ScreenUpdating And Screen Then .ScreenUpdating = True
      If Not .EnableEvents And Events Then .EnableEvents = True
      If .Calculation <> xlAutomatic And Calcula Then .Calculation = xlAutomatic
      '.DisplayAlerts = True
      '.CalculateBeforeSave = True
      '.Cursor = xlDefault
      '.StatusBar = False
      '.EnableCancelKey = xlInterrupt
      '.StatusBar = n_
    End If
  End With
  'oAS.DisplayPageBreaks = False
End Sub

Function IsFileOpen(ByVal FileName As String)
  Dim f As Integer
  On Error Resume Next
  f = FreeFile()
  Open FileName For Input Lock Read As #f
  Close f
  On Error GoTo 0
  Select Case VBA.Err
  Case 0: IsFileOpen = False
  Case 70: IsFileOpen = True
  Case Else: IsFileOpen = VBA.Err
  End Select
  On Error GoTo 0
End Function

Function getFileExtend(ByVal FileName As String)
  Dim i%, s$, f$
  For i = Len(FileName) To 1 Step -1
    f = Mid(FileName, i, 1)
    If f Like "[/.]" Then
      If f = "." Then
        f = s
      End If
      Exit For
    End If
    s = f & s
    f = vbNullString
  Next
  getFileExtend = f
End Function

Private Sub Clipboard_test()
  Call Clipboard("Xin ch" & ChrW(224) & "o t" & ChrW(7845) & "t c" & ChrW(7843) & " c" & ChrW(225) & "c b" & ChrW(7841) & "n")
  Debug.Print Clipboard()
End Sub
Function Clipboard(Optional StoreText As String) As String
  Dim X As Variant
  X = StoreText
  With VBA.CreateObject("htmlfile")
    With .parentWindow.clipboardData
      Select Case True
      Case Len(StoreText)
        .setData "Text", X
      Case Else
        Clipboard = .GetData("Text")
      End Select
    End With
  End With
End Function

Private Sub convertFileVNICode_test()
  Call convertFileVNICode(ThisWorkbook.FullName, 2, 5)
End Sub
Function convertFileVNICode(ByVal FileName$, ByVal fromcode$, ByVal tocode$)
  If IsFileOpen(FileName) Then
    GoTo e
  End If
  Dim Ext$, FSO As Object, f, SF$
  Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
  Set f = FSO.GetFile(FileName)
  SF = f.Name
  Ext = LCase(getFileExtend(FileName))
  Select Case Ext
  Case "xlam", "xla", "xls", "xlsx", "xlsm", "xlsb"
  Case "rst", "csv", "txt", "xml", "htm", "html", "json", "js"
  End Select
e:
  Set FSO = Nothing
End Function

Add-in bên dưới chưa hoàn thành, chỉ để tham khảo:

www.giaiphapexcel.com/diendan/threads/chuy%E1%BB%83n-m%C3%A3-ti%E1%BA%BFng-vi%E1%BB%87t-thay-th%E1%BA%BF-unikey-toolkit-h%C6%A1n-17-ki%E1%BB%83u-m%C3%A3.155072/