|
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 |
|
|
來自： 藥都之鄉(xiāng) > 《我的圖書館》
