sắp xếp họ và tên

Liên hệ QC

hard learner

Thành viên chính thức
Tham gia
4/10/08
Bài viết
74
Được thích
7
Mình hỏi các bạn về cách sắp xếp họ và tên (dùng mã TCVN3). Mình đang gặp khó khăn trong việc sắp xếp vì nhiều quá (500 học sinh)
 
Bạn dùng tạm đoạn mã sau:
Mã:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' neu hoten o 2 cot khac nhau se tu dong noi thanh ten-ho de sap   '
' neu hoten o 1 cot thi se dao nguoc thanh ten-ho roi sap thu tu   '
' luon xem dong dau tien la dong tieu de, khong sap                '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub SapHoTenABC()
Dim ra As Range, r0 As Range, r1 As Range, r2 As Range, r3 As Range
Dim a0(), a1(), a2()    ', a3()
Dim co As Long, ro As Long, c1 As Long, c2 As Long
Dim sh As Worksheet, na
Dim iAscDsc As Integer
    Application.ScreenUpdating = False
    'On Error GoTo 1
    iAscDsc = [COLOR=red][B]xlAscending[/B][/COLOR] ' sap theo thu tu tang
    Set r0 = Selection
    co = r0.Columns.Count
    c1 = r0.Column
    Set ra = r0.CurrentRegion
    ' neu du lieu co dang so - numeric, thi dung excel de sap
    If IsNumeric(r0(1, 1).Value) Then
        ra.Sort Key1:=Cells(ra.Row, c1), order1:=iAscDsc, Header:=xlYes
        GoTo 1
    End If
    c2 = ra.Column
    ra.Offset(1, c1 - c2).Resize(ra.Rows.Count - 1, r0.Columns.Count).Select
    Set r0 = Selection
    ro = r0.Rows.Count
    Set r1 = r0.Columns(1)
    ReDim a0(ro), a1(ro), a2(ro)    ', a3(ro)
    a0 = r0
    a1 = r1
    Set sh = ActiveSheet
    sh.Columns(r0.Column).Insert
    Set r3 = Selection.Columns(1)
 
    r3.Offset(-1, 0).Cells(1, 1).Value = "SortCol"
 
    If co > 1 Then
        Set r2 = r0.Columns(2)
        a2 = r2
        For i = 1 To ro
            a0(i, 1) = Name2Str(a2(i, 1) & " " & a1(i, 1))
            'a3(i, 1) = i
        Next
    Else
        Set r2 = Nothing
        For i = 1 To ro
            a0(i, 1) = Name2Str(RevName("" & a1(i, 1)))
        Next
    End If
    r3 = a0
    Set ra = r3.CurrentRegion
    ra.Sort Key1:=Cells(ra.Row, r3.Column), order1:=iAscDsc, Header:=xlYes
    sh.Columns(r3.Column).Delete
1:
    Set r0 = Nothing: Set r1 = Nothing: Set r2 = Nothing: Set r3 = Nothing
    Set ra = Nothing: Set sh = Nothing
    Application.ScreenUpdating = True
End Sub
Private Function RevName(ByVal st As String) As String
Dim i As Long
    st = Trim(st)  'DelSpace(st)
    i = InStrRev(st, Space(1))
    RevName = Right(st, Len(st) - i) & IIf(i > 0, Space(1), "") & Left(st, IIf(i > 0, i - 1, 0))
End Function
Private Function Name2Str(s As String) As String
Const [COLOR=red][B]maABC[/B][/COLOR] = " 0123456789Aa¸µ¶·¹¡¨¾»¼½Æ¢©ÊÇÈÉËBbCcDd§®EeÐÌÎÏÑ£ªÕÒÓÔÖFfGgHhIiÝ×ØÜÞJjKkLlMmNnOoãßáâ䤫èåæç饬íêëìîPpQqRrSsTtUuóïñòô¦­øõö÷ùVvWwXxYyýúûüþZz"
Const lMax = 30
Dim i As Long
Dim l As Long
Dim st As String, te As String
    l = Len(s)
    s = s & String(lMax - l, " ")
    l = Len(s)
    st = ""
    For i = 1 To l
        te = InStr(maABC, Mid(s, i, 1)) & ""
        st = st & String(3 - Len(te), "0") & te
    Next
    Name2Str = "'" & st
End Function

Trong đó, tôi sắp tăng dần (bạn có thể đổi 1 ít để sắp giảm nếu muốn). Ngoài ra, tôi sắp dấu theo thứ tự: ' ` ? ~ . Nếu thích thì bạn định nghĩa lại bộ mã để sắp.

Cách dùng: nếu họ tên ở trong 1 ô thì chỉ cần đứng tại 1 ô và gọi marco. nếu ở trên 2 ô (họ lót, và tên) thì chọn 2 ô rồi gọi marco.
 
Lần chỉnh sửa cuối:
Upvote 0
Mình đang dùng thử phần hướng dẫn của bác Cop. Hic, nhưng sao mình mới chỉ ấn Install là Ok rồi, chả thấy cần tạo 2 file cài đặt như trong hướng dẫn. Cảm ơn các bác nhiều.Mà cho mình hỏi, khi mình cài lại máy thì Add in đó có mất không?
 
Upvote 0
Mình đang dùng thử phần hướng dẫn của bác Cop. Hic, nhưng sao mình mới chỉ ấn Install là Ok rồi, chả thấy cần tạo 2 file cài đặt như trong hướng dẫn. Cảm ơn các bác nhiều.Mà cho mình hỏi, khi mình cài lại máy thì Add in đó có mất không?

Bạn đóng Excel lại rồi mở lên mới có Add In Tiện Ích Tiếng Việt bạn à. Nếu mở lại vẫn không có bạn vào Tools>>Add-Ins để chọn nó nhé.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom