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

Thảo luận trong 'Access và VBA' bắt đầu bởi lehongduc, 10/7/17.

  1. lehongduc

    lehongduc Member Hội viên mới

    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.
    Mã:
    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
    
    Mã:
    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.
    Mã:
    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
    
    Mã:
    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.
     

    Các file đính kèm:

                   

Chia sẻ trang này

XenForo Add-ons by Brivium ™ © 2012-2013 Brivium LLC.