• Trang chủ click to expand contents 

  • Sắp xếp danh sách tiếng Việt Unicode

  • Sắp xếp danh sách tiếng Việt Unicode

    lehongduc > 15-07-17, 08:13 AM

    Chào các Bạn,
    Nhiều Bạn gửi tin nhắn và email đề nghị tôi giải thích rõ hơn nữa việc sắp xếp tiếng Việt Unicode trong MS. Access và từng dòng lệnh VBA để làm việc này, nên tôi xin được tách vấn đề này riêng ra và trao đổi cụ thể hơn như sau:

    Xin trở lại từ đầu yêu cầu sắp xếp danh sách tiếng Việt như sau:
    1. Quy tắc sắp xếp danh sách tiếng Việt như sau:
    - Thứ tự sắp xếp các nguyên âm có dấu của tiếng Việt là: Không dấu -> Huyền -> Sắc -> Hỏi -> Ngã -> Nặng
    - Nếu là sắp xếp danh sách theo Họ và Tên, thứ tự sắp xếp là: xếp theo Tên -> xếp theo Chữ lót -> xếp theo Họ.

    2. Giải pháp:
    - Cách đơn giản nhất là mã hóa chuỗi tiếng Việt thành chuỗi thuần latinh không dấu, sau đó sử dụng chức năng Sort của MS. Access để sắp xếp tooàn bộ danh sách.
    - Đối với danh sách Họ và Tên, trình tự cụ thể sẽ là:
    + Tách nguyên chuỗi Họ và Tên thành các cột riêng biệt thích hợp: cột Tên và cột Chữ Lót và Họ (nghĩa là có đảo ngược chuỗi "Họ và chữ lót" thành "Chữ lót và Họ")
    + Mã hóa các cột vừa tách và sử dụng chức năng Sort để sắp xếp danh sách theo "Tên" và theo "Chữ lót và Họ".

    3. Viết các procedure VBA cần thiết để tách cột, đảo chuổi và mã hóa như sau:
    + Để tách cột Họ và Tên:
    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

    Trong bài kế tiếp tôi sẽ giải thích các procedure còn lại.
    Xin nhờ các Bạn Quản trị sửa giúp các đoạn ghi chú giải thích trong khung code để các Bạn dễ đọc.

  • RE: Sắp xếp danh sách tiếng Việt Unicode

    lehongduc > 15-07-17, 08:43 AM

    ... tiếp theo ...
    + Để thực hiện việc đảo ngược chuỗi "Họ và Chữ lót" thành "Chữ lót và Họ":

    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

  • RE: Sắp xếp danh sách tiếng Việt Unicode

    lehongduc > 15-07-17, 08:52 AM

    ... tiếp theo ...

    Function FindInArray sau đây dùng để xác định vị trí của 1 giá trị là thành phần nằm trong 1 Array
    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

  • RE: Sắp xếp danh sách tiếng Việt Unicode

    lehongduc > 15-07-17, 09:15 AM

    ... tiếp theo ...
    Function dùng để mã hóa chuỗi Unicode tiếng Việt

    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