duong22000
Thành viên thường trực
- Tham gia
- 8/5/13
- Bài viết
- 322
- Được thích
- 23
Code VBA em đang dùng:
Sub XeptenABC()
Application.ScreenUpdating = False
Dim n As Long
n = Sheet2.[c65000].End(3).Row
Range("do7:do" & n).FormulaR1C1 = "=MahoaUNI(TachTen(RC3,3))"
Range("dp7:dp" & n).FormulaR1C1 = "=MahoaUNI(TachTen(RC3,2))"
Range("dq7:dq" & n).FormulaR1C1 = "=MahoaUNI(tachten(RC3,1))"
Range("B7:dq" & n).Sort Key1:=[do7], Order1:=1, Key2:=[dp7], Order2:=1, Key3:=[dq7], Order3:=1, Header:=xlNo
Range("do7:dq" & n).Clear
Application.ScreenUpdating = True
MsgBox "Da xep xong!"
End Sub
Function TachTen(str As String, Optional Op As Long = 3)
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "(\S+)( .+ | )(\S+$)"
TachTen = Trim(.Execute(Trim(str))(0).SubMatches(Op - 1))
End With
End Function
Public Function MahoaUNI(S) As String
Dim x, Sb, k, mu, skdau, sdau, Bdau, Bkdau As String
Dim i, m, n, dau, idau, ikdau As Integer
If IsNull(S) Then
Exit Function
ElseIf IsNumeric(S) Then
Sb = S
Else
S = Trim(S)
S = LCase(S) & ChrW(32)
skdau = ChrW(259) & ChrW(234) & ChrW(244) & ChrW(432) & ChrW(273) & ChrW(226) & ChrW(417)
Bkdau = "aeoudao"
sdau = ChrW(225) & ChrW(224) & ChrW(7843) & ChrW(227) & ChrW(7841) _
& ChrW(233) & ChrW(232) & ChrW(7867) & ChrW(7869) & ChrW(7865) _
& ChrW(237) & ChrW(236) & ChrW(7881) & ChrW(297) & ChrW(7883) _
& ChrW(243) & ChrW(242) & ChrW(7887) & ChrW(245) & ChrW(7885) _
& ChrW(250) & ChrW(249) & ChrW(7911) & ChrW(361) & ChrW(7909) _
& ChrW(253) & ChrW(7923) & ChrW(7927) & ChrW(7929) & ChrW(7925) _
& ChrW(7855) & ChrW(7857) & ChrW(7859) & ChrW(7861) & ChrW(7863) _
& ChrW(7889) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7897) _
& ChrW(7871) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7879) _
& ChrW(7913) & ChrW(7915) & ChrW(7917) & ChrW(7919) & ChrW(7921) _
& ChrW(7845) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7853) _
& ChrW(7899) & ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7907)
Bdau = "aaaaaeeeeeiiiiiooooouuuuuyyyyyaaaaaoooooeeeeeuuuuuaaaaaooooo"
For m = 1 To Len(S)
k = Mid(S, m, 1)
idau = InStr(1, sdau, k, 0)
ikdau = InStr(1, skdau, k, 0)
If idau > 0 Then
k = Mid(Bdau, idau, 1)
dau = idau Mod 5
If dau = 0 Then
dau = 5
End If
If idau > 0 And idau < 31 Then
mu = ""
ElseIf idau > 30 And idau < 51 Then
mu = "z"
Else
mu = "zw"
End If
k = k & mu
ElseIf ikdau > 0 Then
k = Mid(Bkdau, ikdau, 1)
If ikdau < 6 Then
k = k & "z"
Else
k = k & "zw"
End If
ElseIf k = ChrW(32) Then
k = dau & ChrW(32)
dau = ""
End If
x = x & k
Next
Sb = Sb & x
End If
MahoaUNI = Sb
End Function
Tuy nhiên Code trên xếp Alphabet danh sách học sinh chưa được như ý muốn
VD 2 học sinh sau khi xếp thì có thứ tự như sau:
1. Nguyễn Quỳnh Nhi
2. Nguyễn Thị Anh Nhi
Nhưng theo đúng DSHS của GVCN lớp lại xếp là:
1. Nguyễn Thị Anh Nhi
2. Nguyễn Quỳnh Nhi
(Vì Anh Nhi trước Quỳnh Nhi)
(Chắc là lấy từng tên đệm gần tên chính trước, sau đó dịch dần về phía Họ, vì tên đệm của học sinh có thể 1 từ, 2 từ, ... )
Bây giờ em muốn xếp DSHS theo GVCN lớp xếp thì em cần sửa gì không?
Mong mọi người trên GPE giúp em với, xin cảm ơn mọi người....
Sub XeptenABC()
Application.ScreenUpdating = False
Dim n As Long
n = Sheet2.[c65000].End(3).Row
Range("do7:do" & n).FormulaR1C1 = "=MahoaUNI(TachTen(RC3,3))"
Range("dp7:dp" & n).FormulaR1C1 = "=MahoaUNI(TachTen(RC3,2))"
Range("dq7:dq" & n).FormulaR1C1 = "=MahoaUNI(tachten(RC3,1))"
Range("B7:dq" & n).Sort Key1:=[do7], Order1:=1, Key2:=[dp7], Order2:=1, Key3:=[dq7], Order3:=1, Header:=xlNo
Range("do7:dq" & n).Clear
Application.ScreenUpdating = True
MsgBox "Da xep xong!"
End Sub
Function TachTen(str As String, Optional Op As Long = 3)
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "(\S+)( .+ | )(\S+$)"
TachTen = Trim(.Execute(Trim(str))(0).SubMatches(Op - 1))
End With
End Function
Public Function MahoaUNI(S) As String
Dim x, Sb, k, mu, skdau, sdau, Bdau, Bkdau As String
Dim i, m, n, dau, idau, ikdau As Integer
If IsNull(S) Then
Exit Function
ElseIf IsNumeric(S) Then
Sb = S
Else
S = Trim(S)
S = LCase(S) & ChrW(32)
skdau = ChrW(259) & ChrW(234) & ChrW(244) & ChrW(432) & ChrW(273) & ChrW(226) & ChrW(417)
Bkdau = "aeoudao"
sdau = ChrW(225) & ChrW(224) & ChrW(7843) & ChrW(227) & ChrW(7841) _
& ChrW(233) & ChrW(232) & ChrW(7867) & ChrW(7869) & ChrW(7865) _
& ChrW(237) & ChrW(236) & ChrW(7881) & ChrW(297) & ChrW(7883) _
& ChrW(243) & ChrW(242) & ChrW(7887) & ChrW(245) & ChrW(7885) _
& ChrW(250) & ChrW(249) & ChrW(7911) & ChrW(361) & ChrW(7909) _
& ChrW(253) & ChrW(7923) & ChrW(7927) & ChrW(7929) & ChrW(7925) _
& ChrW(7855) & ChrW(7857) & ChrW(7859) & ChrW(7861) & ChrW(7863) _
& ChrW(7889) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7897) _
& ChrW(7871) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7879) _
& ChrW(7913) & ChrW(7915) & ChrW(7917) & ChrW(7919) & ChrW(7921) _
& ChrW(7845) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7853) _
& ChrW(7899) & ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7907)
Bdau = "aaaaaeeeeeiiiiiooooouuuuuyyyyyaaaaaoooooeeeeeuuuuuaaaaaooooo"
For m = 1 To Len(S)
k = Mid(S, m, 1)
idau = InStr(1, sdau, k, 0)
ikdau = InStr(1, skdau, k, 0)
If idau > 0 Then
k = Mid(Bdau, idau, 1)
dau = idau Mod 5
If dau = 0 Then
dau = 5
End If
If idau > 0 And idau < 31 Then
mu = ""
ElseIf idau > 30 And idau < 51 Then
mu = "z"
Else
mu = "zw"
End If
k = k & mu
ElseIf ikdau > 0 Then
k = Mid(Bkdau, ikdau, 1)
If ikdau < 6 Then
k = k & "z"
Else
k = k & "zw"
End If
ElseIf k = ChrW(32) Then
k = dau & ChrW(32)
dau = ""
End If
x = x & k
Next
Sb = Sb & x
End If
MahoaUNI = Sb
End Function
Tuy nhiên Code trên xếp Alphabet danh sách học sinh chưa được như ý muốn
VD 2 học sinh sau khi xếp thì có thứ tự như sau:
1. Nguyễn Quỳnh Nhi
2. Nguyễn Thị Anh Nhi
Nhưng theo đúng DSHS của GVCN lớp lại xếp là:
1. Nguyễn Thị Anh Nhi
2. Nguyễn Quỳnh Nhi
(Vì Anh Nhi trước Quỳnh Nhi)
(Chắc là lấy từng tên đệm gần tên chính trước, sau đó dịch dần về phía Họ, vì tên đệm của học sinh có thể 1 từ, 2 từ, ... )
Bây giờ em muốn xếp DSHS theo GVCN lớp xếp thì em cần sửa gì không?
Mong mọi người trên GPE giúp em với, xin cảm ơn mọi người....
