Sub Main()
Dim Darr()
Darr = Range("A1:E" & Range("B" & Rows.Count).End(xlUp).Row).Value
Arr = SortArray(Darr, True, 2, True, 3, True, 4, True)
Range("G1").Resize(UBound(Darr), UBound(Darr, 2)) = Arr
End Sub
Function SortArray(ByVal SourceArray, ByVal HasTitle As Boolean, ByVal ColIndex1 As Byte, _
Optional ByVal Order1 As Boolean = True, Optional ByVal ColIndex2 As Byte = 0, _
Optional ByVal Order2 As Boolean = True, Optional ByVal ColIndex3 As Byte = 0, _
Optional ByVal Order3 As Boolean = True)
Dim Darr(), Arr()
Dim i As Long, iP As Long, ir As Long, k As Long, R As Long, LenR As Byte, Tmp
Darr = SourceArray
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
If ColIndex1 >= 1 And ColIndex1 <= UBound(Darr, 2) Then
If ColIndex2 = 0 Then
Arr = SortArray1Col(Darr, ColIndex1, Order1, HasTitle, True)
Else
Arr = SortArray1Col(Darr, ColIndex1, Order1, HasTitle)
If ColIndex2 >= 1 And ColIndex2 <= UBound(Darr, 2) Then
Darr = Arr
Arr = SortArray2Col(Darr, ColIndex1, ColIndex2, Order2, HasTitle)
If ColIndex3 >= 1 And ColIndex3 <= UBound(Darr, 2) Then
Darr = Arr
Arr = SortArray2Col(Darr, ColIndex2, ColIndex3, Order3, HasTitle)
End If
End If
End If
SortArray = Arr
End If
End Function
Function SortArray1Col(ByVal SourceArray, ByVal ColIndex As Byte, Optional ByVal Order As Boolean = True, _
Optional ByVal HasTitle As Boolean = False, Optional ByVal HideTitle As Boolean = False)
Dim IndexList As Object, List As Object, Darr(), Arr()
Dim i As Long, j As Byte, k As Long, R As Long, LenR As Integer, Tmp
Set IndexList = CreateObject("System.Collections.ArrayList")
Darr = SourceArray
R = UBound(Darr) + HasTitle 'so dong du lieu Sort
LenR = Len(CStr(R)) 'so chu so cua thu tu dong
If ColIndex < 1 Or ColIndex > UBound(Darr, 2) Then
MsgBox ("ColIndex khong phu hop" & Chr(13) & "Sort Data Khong duoc thuc hien")
SortArray1Col = Darr
Exit Function
End If
For i = 1 To R
Tmp = Darr(i - HasTitle, ColIndex)
If IsNumeric(Tmp) Then Tmp = CStr(String(15 - Len(CStr(Tmp)), "0") & Tmp)
Tmp = Tmp & String(LenR - Len(CStr(i)), "0") & i
IndexList.Add Tmp
Next
Set List = IndexList.Clone
List.Sort
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
If HasTitle = False Then HideTitle = False
If HideTitle Then
ReDim Arr(1 To R, 1 To UBound(Darr, 2))
Else
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
If HasTitle Then
For j = 1 To UBound(Darr, 2)
Arr(1, j) = Darr(1, j)
Next j
End If
End If
For i = 0 To R - 1
k = IndexList.InDexOf(List(i), 0) + 1
For j = 1 To UBound(Darr, 2)
If Order Then n = i + 1 Else n = R - i
If HideTitle Then
Arr(n, j) = Darr(k - HasTitle, j)
Else
Arr(n - HasTitle, j) = Darr(k - HasTitle, j)
End If
Next j
Next i
SortArray1Col = Arr
End Function
Function SortArray2Col(ByVal SourceArray, ByVal ColMain As Byte, ByVal ColIndex As Byte, ByVal Order As Boolean, Optional ByVal HasTitle As Boolean = False)
Dim Darr(), Arr()
Dim i As Long, ir As Long, k As Long, R As Long, j As Integer, Tmp
Darr = SourceArray
For i = 1 - HasTitle To UBound(Darr) - 1
If Darr(i, ColMain) = Darr(i + 1, ColMain) Then
R = i
Tmp = Darr(i, ColMain)
k = 0
For ir = R To UBound(Darr)
If Darr(ir, ColMain) = Tmp Then
k = k + 1
Else
Exit For
End If
Next ir
ReDim Arr(1 To k, 1 To UBound(Darr, 2))
For ir = 1 To k
For j = 1 To UBound(Darr, 2)
Arr(ir, j) = Darr(ir + R - 1, j)
Next j
Next ir
Arr = SortArray1Col(Arr, ColIndex, Order)
For ir = 1 To k
For j = 1 To UBound(Darr, 2)
Darr(ir + R - 1, j) = Arr(ir, j)
Next j
Next ir
i = i + k - 1
End If
Next i
SortArray2Col = Darr
End Function
, Thầy Ba Tê đã giúp em code lọc không trùng bằng DIC ra Mảng Arr, rồi nạp Mảng Arr đó vào ListBox, nhưng chưa Sort tăng dần. Bây giờ em muốn mọi người giúp em Sort mảng Arr tăng dần rồi nạp vào ListBox.
