|
Sub tmp()
Dim tmp
tmp = [A1:C10]
tmp = ArraySort(tmp, 1, DESCENDING_ORDER, 3, ASCENDING_ORDER)
[I1].Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
End Sub
Function ArraySort(tmp, ByVal Key1 As Integer, ByVal Order1 As eOrderType, ByVal Key2 As Integer, ByVal Order2 As eOrderType)
Dim i As Integer, j As Integer, Nm As Integer, Nsorted As Integer, r As Integer, m As Double
Dim tmp0, tmp1
ReDim tmp0(LBound(tmp, 1) To UBound(tmp, 1), LBound(tmp, 2) To UBound(tmp, 2))
ReDim tmp1(LBound(tmp, 1) To UBound(tmp, 1), LBound(tmp, 2) To UBound(tmp, 2))
On Error Resume Next
Nsorted = 0
If Order1 = ASCENDING_ORDER Then
Do While Nsorted < (UBound(tmp, 1) - LBound(tmp, 1) + 1)
m = Application.Min(Application.Index(tmp, , Key1))
Nm = 0
For i = LBound(tmp, 1) To UBound(tmp, 1)
If tmp(i, Key1) = m Then
Nm = Nm + 1
For j = LBound(tmp, 2) To UBound(tmp, 2)
tmp0(Nm, j) = tmp(i, j)
tmp(i, j) = ""
Next j
End If
Next i
For i = 1 To Nm
Nsorted = Nsorted + 1
If Order2 = ASCENDING_ORDER Then
m = Application.Min(Application.Index(tmp0, , Key2))
ElseIf Order2 = DESCENDING_ORDER Then
m = Application.Max(Application.Index(tmp0, , Key2))
End If
r = Application.WorksheetFunction.Match(m, Application.Index(tmp0, , Key2), 0)
For j = LBound(tmp, 2) To UBound(tmp, 2)
tmp1(Nsorted, j) = tmp0(r, j)
tmp0(r, j) = ""
Next j
Next i
Loop
ElseIf Order1 = DESCENDING_ORDER Then
Do While Nsorted < (UBound(tmp, 1) - LBound(tmp, 1) + 1)
m = Application.Max(Application.Index(tmp, , Key1))
Nm = 0
For i = LBound(tmp, 1) To UBound(tmp, 1)
If tmp(i, Key1) = m Then
Nm = Nm + 1
For j = LBound(tmp, 2) To UBound(tmp, 2)
tmp0(Nm, j) = tmp(i, j)
tmp(i, j) = ""
Next j
End If
Next i
For i = 1 To Nm
Nsorted = Nsorted + 1
If Order2 = ASCENDING_ORDER Then
m = Application.Min(Application.Index(tmp0, , Key2))
ElseIf Order2 = DESCENDING_ORDER Then
m = Application.Max(Application.Index(tmp0, , Key2))
End If
r = Application.WorksheetFunction.Match(m, Application.Index(tmp0, , Key2), 0)
For j = LBound(tmp, 2) To UBound(tmp, 2)
tmp1(Nsorted, j) = tmp0(r, j)
tmp0(r, j) = ""
Next j
Next i
Loop
End If
ArraySort = tmp1
End Function |
|
|
