Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Sắp xếp danh sách tiếng Việt Unicode
#1
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.
Chữ ký của lehongduc Lê Hồng Đức
Số ĐT: 0913.941.144
Email: lhongduc@gmail.com, lehongduc@quantribanhang.vn
Website: http://quantribanhang.vn
Reply
Những người đã cảm ơn MTNQ , maidinhdan
#2
... 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
Chữ ký của lehongduc Lê Hồng Đức
Số ĐT: 0913.941.144
Email: lhongduc@gmail.com, lehongduc@quantribanhang.vn
Website: http://quantribanhang.vn
Reply
Những người đã cảm ơn maidinhdan
#3
... 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
Chữ ký của lehongduc Lê Hồng Đức
Số ĐT: 0913.941.144
Email: lhongduc@gmail.com, lehongduc@quantribanhang.vn
Website: http://quantribanhang.vn
Reply
Những người đã cảm ơn maidinhdan
#4
... 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
Chữ ký của lehongduc Lê Hồng Đức
Số ĐT: 0913.941.144
Email: lhongduc@gmail.com, lehongduc@quantribanhang.vn
Website: http://quantribanhang.vn
Reply
Những người đã cảm ơn maidinhdan , MTNQ


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Thủ Thuật] Demo Tổng hợp tất cả các kiểu thông báo tiếng việt trong Access maidinhdan 39 8,468 22-09-18, 12:40 PM
Bài mới nhất: NguyenDungAnh
  Unicode trên cửa sổ viết code VBA (IDE) lehongduc 0 543 10-12-17, 09:49 AM
Bài mới nhất: lehongduc
  Hướng Dẫn Thêm nút lăn chuột giao diện viết code VBA maidinhdan 0 379 27-11-17, 05:03 PM
Bài mới nhất: maidinhdan
  [Hỏi] Viết code có điều kiện " lệnh Chạy tiếp khi đóng tbl cho sẵn" Trần Linh 3 1,403 21-10-16, 11:11 AM
Bài mới nhất: Minh Tiên
  Viết phần quyền sử dụng tt1212 9 2,741 01-10-16, 12:26 AM
Bài mới nhất: maidinhdan

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ| PMA Nha Trang| Gỗ Acrylic Không Đường Line