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)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
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?