Xuân Thanh > 04-08-12, 12:51 PM
Public Function SuaCau(CauVan)
CauMoi = Trim(CauVan)
ViTri = InStr(1, CauMoi, Space(2))
Do While ViTri > 0
CauMoi = Left(CauMoi, ViTri) & Trim(Mid(CauMoi, ViTri))
ViTri = InStr(1, CauMoi, Space(2))
Loop
SuaCau = CauMoi
End Function
Public Function XepABC(HoTen)
Ten = SuaCau(Trim(HoTen))
TenMoi = Space(0): One = Space(0): Two = Space(0)
One = One & "a aùaøaûaõaïaêaéaèaúaüaëaâaáaàaåaãaä"
One = One & "o oùoøoûoõoïoâoáoàoåoãoäô ôùôøôûôõôï"
One = One & "e eùeøeûeõeïeâeáeàeåeãeäi í ì æ ó ò "
One = One & "y yùyøyûyõî u uùuøuûuõuïö öùöøöûöõöïd ñ"
Two = Two & "aaabacadaeafagahaiajakalamanaoapaqar"
Two = Two & "oaobocodoeofogohoiojokolomonooopoqor"
Two = Two & "eaebecedeeefegeheiejekeliaibicidieifyaybycydyeyf"
Two = Two & "uaubucudueufuguhuiujukuldadb"
ViTri = InStr(1, Ten, Space(1))
Do While ViTri > 0
TenMoi = Left(Ten, ViTri) & TenMoi
Ten = Mid(Ten, ViTri + 1)
ViTri = InStr(1, Ten, Space(1))
Loop
OldS = Trim(Ten & Space(1) & TenMoi)
NewS = Space(0): LenOf = Len(OldS): ViTri = 1
Do While ViTri <= LenOf
KyTu = Mid(OldS, ViTri, 1)
If KyTu = Space(1) Then
NewS = NewS & KyTu: ViTri = ViTri + 1
Else
LowK = LCase(KyTu): OldP = InStr(1, One, LowK)
If OldP = 0 Then
NewS = NewS & KyTu: ViTri = ViTri + 1
Else
KeTiep = LCase(Mid(OldS, ViTri, 2))
NewP = InStr(1, One, KeTiep)
If NewP = 0 Then
NewS = NewS & Trim(IIf(Asc(KyTu) = Asc(LCase(KyTu)), Mid(Two, OldP, 2), UCase(Mid(Two, OldP, 2))))
ViTri = ViTri + 1
Else
NewS = NewS & Trim(IIf(Asc(KyTu) = Asc(LCase(KyTu)), Mid(Two, NewP, 2), UCase(Mid(Two, NewP, 2))))
ViTri = ViTri + Len(Trim(KeTiep))
End If
End If
End If
Loop
XepABC = Trim(NewS)
End Function
nhunguyet0103 > 04-08-12, 09:46 PM
Xuân Thanh > 08-08-12, 11:34 AM
Xuân Thanh > 08-08-12, 11:45 AM
Public Function DaoTen(Ten As String) As String
Dim ViTri, TenMoi As String
ViTri = InStr(1, Ten, Space(1))
Do While ViTri > 0
TenMoi = Left(Ten, ViTri) & TenMoi
Ten = Mid(Ten, ViTri + 1)
ViTri = InStr(1, Ten, Space(1))
Loop
DaoTen = Trim(Ten & Space(1) & TenMoi)
End Function
Public Function XepABC(HoTen As String) As String
Dim chmh, ktdoi, chuv, chkq, kti As String
Dim i, vt, nn3
chmh = Space(0)
chmh = chmh & "aaabacadaeafagahaiajakalamanaoapaqarasatauavawaxaybabcbbbdbebfbgb"
chmh = chmh & "hbibjbkblbmbnbobpbqbrbsbtbubvbwbxbybzcacbcccdcecfcgchcicjckclcmcncocpcqcr"
chmh = chmh & "csctcucvcwcxcyczdadbdcdddedfdgdhdidjdkdldmdndodpdqdrdsdtdudvdwdxdydzeaeb"
chmh = chmh & "ecedeeefegeheiejekelemeneoepeqereseteuevewexeyezfafbfcfdfefffgfhfifjfkflfmfnfofpfqf"
chmh = chmh & "rfsftfufvfwfxfyfzgagbgcgdgegfggghgigjgkglgmgngogpgqgrgsgtgugvgwgxgygzhahbhchd"
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblChuaMa", dbOpenDynaset)
chuv = rs!Ma
HoTen = DaoTen(HoTen)
nn3 = Len(HoTen)
chkq = ""
For i = 1 To nn3
kti = Mid(HoTen, i, 1)
vt = InStr(chuv, kti)
If vt <> 0 Then
ktdoi = Mid(chmh, 2 * vt - 1, 2)
chkq = chkq + ktdoi
Else
chkq = chkq + kti
End If
Next i
XepABC = chkq
End Function
nhunguyet0103 > 26-08-12, 11:14 PM