Sắp xếp danh sách tiếng Việt Unicode trong MS. Access

[lehongduc]

Chào các Bạn,
Có một số Bạn gửi email hỏi tôi về việc sắp xếp danh sách tiếng Việt Unicode trong MS. Access.
Đáp ứng yêu cầu đó, tôi xin trao đổi với các Bạn một cách sắp xếp danh sách tiếng Việt Unicode bằng giải pháp đơn giản như sau:
Bài toán sắp xếp danh sách tiếng Việt có thể được giải theo nhiều cách, sau đây là một cách đơn giản nhất, dễ hiểu với các Bạn mới tìm hiểu MS. Access:

1. Nếu là sắp xếp danh sách Họ và Tên người, theo quy tắc sắp xếp tiếng Việt:
+ Xếp thứ tự theo "tên" trước
+ Sau đó sắp theo "chữ lót" rồi tới "Họ"

Thứ tự sắp xếp các nguyên âm có dấu thanh tiếng Việt là: không dấu -> huyền -> sắc -> hỏi -> ngã -> nặng.

2. Như vậy ta cần phải tách cột "Họ và Tên" thành 2 cột phân biệt là: "Tên" và "Họ và chữ lót"
Vì quy tắc thứ tự sắp xếp là: "tên" -> "chữ lót" rồi mới tới "Họ", nên ta sẽ phải đảo ngược "Họ và chữ lót" thành "Chữ lót và Họ"
Vậy là ta phải viết code VBA để:
+ tách cột
+ và đảo chuỗi.

Function TachTen(HoVaTen As String) As String

Dim Ten As String
Dim i As Integer
Dim nTu As Integer
Dim St As String
Dim LngSt As Integer

HoVaTen = Trim(HoVaTen)
LngSt = Len(HoVaTen)

'Đoạn mã sau đây để xác định vị trí của ký tự trắng ngăn cách các từ trong chuỗi Họ và Tên, tính từ bên phải sang trái
'Bởi mục đích là ta tách phần Tên ra khỏi chuỗi Họ và Tên
i = InStrRev(HoVaTen, " ")

'Nếu chuỗi Họ và Tên chỉ có 1 từ (không có ký tự trắng ngăn cách nào)
If i = 0 Then
'Thì lấy nguyên từ duy nhất đó
  Ten = HoVaTen
Else
  Ten = Right(HoVaTen, LngSt - i)
End If
TachTen = Ten
End Function

Function DaoChuoi(ChuoiDuaVao As String) As String
Dim LngSt As Integer, i As Integer
Dim ChuoiDao As String, ChuoiCon As String
ChuoiDuaVao = Trim(ChuoiDuaVao)
LngSt = Len(ChuoiDuaVao)

'Thực hiện vòng lặp Do để đảo chuỗi
Do
    'Để lấy ra từng từ
    ' Các Bạn chú ý là ta phải lấy ra từng từ chứ không phải từng ký tự
    ' Ta biết rằng mỗi từ trong chuỗi đợc ngăn cách bằng 1 ký tự trắng.
    ' Do vậy để lấy ra từng từ ta chỉ cần xác định vị trí của ký tự trắng ấy là biết chiều dài của từ cần lấy ra
    ' Dòng lệnh dưới đây để xác định vị trí của ký tự trắng đó.
  i = InStr(1, ChuoiDuaVao, " ")

    'Biến ChuoiDuaVao là chỉ chuỗi đã được cắt bỏ từ đã đơợc tách sau mỗi lần lặp 
    'Nếu không còn ký tự trắng nào nữa, hoặc không có ký tự trắng nào trong chuỗi (chuỗi chỉ có 1 từ)
  
  If i = 0 Then
  ChuoiDao = ChuoiDuaVao & " " & ChuoiDao
  Exit Do
  Else
        'Tách lấy từ là ChuoiCon với chiều dài của từ là vị trí i -1
  ChuoiCon = Left(ChuoiDuaVao, i - 1)
  End If

    'Dòng lệnh sau để:
    'Nối chuỗi con (ChuoiCon) vừa tách được ở trên vào đầu chuỗi đã được đảo ngược (ChuoiDao)
    'Chú ý: Không nối chuỗi con vào cuối ChuoiDao
  ChuoiDao = ChuoiCon & " " & ChuoiDao

    'Dòng lệnh sau để xác định chuỗi còn lại (ChuoiDuaVao) sau khi đã tách từ ở bên trái ra
  ChuoiDuaVao = right(ChuoiDuaVao, Len(ChuoiDuaVao) - Len(ChuoiCon) - 1)
Loop
DaoChuoi = ChuoiDao
End Function

3. Muốn sắp xếp tiếng Việt, ta chỉ cần mã hóa chuỗi các ký tự tiếng Việt (nguyên âm và phụ âm chữ việt) thành chuỗi các ký tự la tinh không dấu.
Vậy là ta phải viết code VBA để làm cái công việc mã hóa này.
Sau đó ta cho sắp xếp bằng công cụ Sorting của Access là xong.

Function FindInArray(pList, pValue)
  'Xac dinh vi tri cua gia tri pValue trong Array List pList
  Dim i As Integer
  Dim FoundValueLocation As Integer 'Vi tri cua pValue trong pList
  FoundValueLocation = -1

  'Vị trí của các thành phần trong 1 Array được xác định bắt đầu từ 0
  ' UBound là hàm xác định vị trí của thành phần cuối cùng của 1 Array 

  For i = 0 To UBound(pList)
  If pList(i) = pValue Then
  FoundValueLocation = i
  Exit For
  End If
  Next i
  FindInArray = FoundValueLocation
End Function

Function mh(UnicodeText)

Dim LngSt As Integer
Dim i As Integer
Dim UniStr As String, MhStr As String
Dim UniArr, MhArr
Dim SubStr As String, k As Integer
Dim ReStr As String

'Tac dung: Ma hoa chuoi Unicode (UnicodeText)
'Lập chuỗi các ký tự mang dấu tiếng Việt Unicode gán cho biến UniStr
UniStr = "," & ChrW(97) & "," & ChrW(224) & "," & ChrW(225) & "," & ChrW(7843) & "," & ChrW(227) & "," & ChrW(7841)
UniStr = UniStr & "," & ChrW(259) & "," & ChrW(7857) & "," & ChrW(7855) & "," & ChrW(7859) & "," & ChrW(7861) & "," & ChrW(7863)
UniStr = UniStr & "," & ChrW(226) & "," & ChrW(7847) & "," & ChrW(7845) & "," & ChrW(7849) & "," & ChrW(7851) & "," & ChrW(7853)
UniStr = UniStr & "," & ChrW(101) & "," & ChrW(232) & "," & ChrW(233) & "," & ChrW(7867) & "," & ChrW(7869) & "," & ChrW(7865)
UniStr = UniStr & "," & ChrW(234) & "," & ChrW(7873) & "," & ChrW(7871) & "," & ChrW(7875) & "," & ChrW(7877) & "," & ChrW(7879)
UniStr = UniStr & "," & ChrW(105) & "," & ChrW(236) & "," & ChrW(237) & "," & ChrW(7881) & "," & ChrW(297) & "," & ChrW(7883)
UniStr = UniStr & "," & ChrW(117) & "," & ChrW(249) & "," & ChrW(250) & "," & ChrW(7911) & "," & ChrW(361) & "," & ChrW(7909)
UniStr = UniStr & "," & ChrW(432) & "," & ChrW(7915) & "," & ChrW(7913) & "," & ChrW(7917) & "," & ChrW(7919) & "," & ChrW(7921)
UniStr = UniStr & "," & ChrW(111) & "," & ChrW(242) & "," & ChrW(243) & "," & ChrW(7887) & "," & ChrW(245) & "," & ChrW(7885)
UniStr = UniStr & "," & ChrW(244) & "," & ChrW(7891) & "," & ChrW(7889) & "," & ChrW(7893) & "," & ChrW(7895) & "," & ChrW(7897)
UniStr = UniStr & "," & ChrW(417) & "," & ChrW(7901) & "," & ChrW(7899) & "," & ChrW(7903) & "," & ChrW(7905) & "," & ChrW(7907)
UniStr = UniStr & "," & ChrW(100) & "," & ChrW(273)
UniStr = UniStr & "," & ChrW(121) & "," & ChrW(7923) & "," & ChrW(253) & "," & ChrW(7927) & "," & ChrW(7929) & "," & ChrW(7925)

'Lập chuỗi mã hóa gán cho biến MhStr (mã hóa các ký tự mang dấu tiếng Việt Unicode)
MhStr = ",a00,a01,a02,a03,a04,a05" 'a
MhStr = MhStr & ",a10,a11,a12,a13,a14,a15" 'aw
MhStr = MhStr & ",a20,a21,a22,a23,a24,a25" 'â
MhStr = MhStr & ",e00,e01,e02,e03,e04,e05" 'e
MhStr = MhStr & ",e10,e11,e12,e13,e14,e15" 'ê
MhStr = MhStr & ",i00,i01,i02,i03,i04,i05" 'i
MhStr = MhStr & ",u00,u01,u02,u03,u04,u05" 'u
MhStr = MhStr & ",u10,u11,u12,u13,u14,u15" 'uw
MhStr = MhStr & ",o00,o01,o02,o03,o04,o05" 'o
MhStr = MhStr & ",o10,o11,o12,o13,o14,o15" 'ô
MhStr = MhStr & ",o20,o21,o22,o23,o24,o25" 'ow
MhStr = MhStr & ",d0,d1" 'dd
MhStr = MhStr & ",y00,y01,y02,y03,y04,y05" 'y

'Sử dụng Function Split (đây là Func của bản thân VBA)
'Để chuyển các chuỗi UniStr và MhStr sang Array:
'+ UniArr: là danh sách các ký tự Unicode tiếng Việt
'+ MhArr: là danh sách chuỗi mã hóa tương ứng
'Nhằm mục đích dễ xác định chuỗi mã hóa tương ứng

UniArr = Split(UniStr, ",")
MhArr = Split(MhStr, ",")

'Cắt các khoảng trống ở 2 đầu của Chuỗi Unicode đưa vào
UnicodeText = Trim(UnicodeText)

'Chuyển toàn bộ chuỗi Unicode sang chữ thường bằng function LCase của VBA
UnicodeText = LCase(UnicodeText)
'
LngSt = Len(UnicodeText)

'Duyệt từ đầu chuỗi đến cuối chuỗi Unicode đưa vào
'Lấy từng ký tự ra để kiểm tra xem
'có nằm trong danh sách các ký tự Unicode tiếng Việt hay không (Array UniArr)
'Nếu có, nghĩa là ký tự đó là ký tự Unicode tiếng Việt
'Ta sẽ xác định vị trí ký tự này trong danh sách Unicode tiếng Việt (Array UniArr)
'Từ đó lấy ra chuỗi mã hóa ở vị trí tương ứng trong danh sách mã hóa (Array MhArr)

For i = 1 To LngSt

  SubStr = Mid(UnicodeText, i, 1)  'Tách từng ký tự ra
  'Xác định vị trí của ký tự vừa tách ra bằng Func FindInArray ta đã viết ở trên
  'Xem có hay không có trong danh sách ký tự Unicode tiếng Việt
  k = FindInArray(UniArr, SubStr)

  'Nếu có
  If k > 0 Then
  SubStr = MhArr(k) 'Nếu có trong UniArr thì lấy chuỗi mã hóa tương ứng trong danh sách ký tự mã hóa MhArr
  End If
  ReStr = ReStr & SubStr 'Nối chuỗi tìm được vào chuỗi mã hóa

Next i

mh = ReStr
End Function

Và đây là Link tải xuống file mdb có sẵn các thành phần cần thiết để các Bạn tiện tham khảo:
+ Code VBA bao gồm các Function cần thiết: tách cột, mã hóa chuỗi Unicode
+ Bảng danh sách Họ và Tên với trên 7.000 dòng
+ Query dùng để kiểm tra

Link tải xuống: http://www.mediafire.com/file/pbwwm4hyom9ph5h/SortUniCodeString.zip
Hoặc file đính kèm.