maidinhdan > 27-06-19, 06:03 AM
Option Compare Database
'Option Explicit
Public Mang() As Variant
Function TaoMang(TenTable As String, TenCotCanXepHang As String, Optional XepTangdan As Boolean = True)
Dim rs As Recordset
Dim sql As String
Dim a As String, s As String
On Error GoTo Loi
Dim SoPhanTu As Long
Dim Mang1() As Variant
sql = "SELECT " & TenCotCanXepHang & " FROM " & TenTable & " GROUP BY " & TenCotCanXepHang
Set rs = CurrentDb.OpenRecordset(sql)
If rs.RecordCount > 0 Then
SoPhanTu = rs.RecordCount
ReDim Mang1(SoPhanTu)
rs.MoveFirst
i = 0
Do Until rs.EOF
Mang1(i) = rs.Fields(TenCotCanXepHang)
i = i + 1
rs.MoveNext
Loop
Mang() = Mang1()
If XepTangdan = True Then
XepMangTangDan
Else
XepMangGiamDan
End If
End If
ThoatLoi:
rs.Close
Exit Function
Loi:
Resume ThoatLoi
End Function
Function HamXepHang3(TenTable As String, TenCotCanXepHang As String, SoCanXephang As Long)
On Error GoTo Loi
Dim i As Variant
i = UBound(Mang())
If i <> 0 Then
TaoMang "BangLuong", "NGAYCONG"
End If
ThoatLoi:
HamXepHang3 = VitriPhantu(Mang, SoCanXephang)
Exit Function
Loi:
TaoMang "BangLuong", "NGAYCONG"
Resume ThoatLoi
End Function
Private Function VitriPhantu(Mang As Variant, TenPhanTuCanTim As Variant) As Variant
Dim i As Long
For i = LBound(Mang) To UBound(Mang)
If Mang(i) = TenPhanTuCanTim Then
VitriPhantu = i
Exit Function
End If
Next i
VitriPhantu = Null
End Function
Public Sub XepMangTangDan()
Dim arr() As Variant
arr = Mang()
lngMin = LBound(arr)
lngMax = UBound(arr)
For i = lngMin To lngMax - 1
For j = i + 1 To lngMax
If arr(i) > arr(j) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
Next j
Next i
Mang() = arr
End Sub
Public Sub XepMangGiamDan()
Dim arr() As Variant
arr = Mang()
lngMin = LBound(arr)
lngMax = UBound(arr)
For i = lngMin To lngMax - 1
For j = i + 1 To lngMax
If arr(i) < arr(j) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
Next j
Next i
Mang() = arr
End Sub