クイックソート(配列バージョン)
始めたばかりですが、息切れ始まった感じです。
とりあえず、クイックソートの配列バージョンです。
正直、エラー処理などもっとスマートにできる気がしますが、公開します。
Private Sub QuickSortArrayTest() Dim temp As Variant Dim data(0 To 3) As Variant data(0) = 4 data(1) = 3 data(2) = 2 data(3) = 1 Debug.Print QuickSortArray(data) End Sub Private Function QuickSortArray(ByRef data() As Variant) As Variant Dim pivot As Variant Dim less() As Variant Dim greater() As Variant Dim num As Long Dim i As Long On Error Resume Next num = UBound(data) If Err.Number <> 0 Then QuickSortArray = vbNullString Exit Function End If On Error GoTo 0 If UBound(data) < 1 Then QuickSortArray = data(0) Else pivot = data(0) For i = LBound(data) + 1 To UBound(data) If data(i) <= pivot Then On Error Resume Next ReDim Preserve less(UBound(less) + 1) If Err.Number = 0 Then 'Do Nothing Else ReDim less(0) End If On Error GoTo 0 less(UBound(less)) = data(i) ElseIf data(i) > pivot Then On Error Resume Next ReDim Preserve greater(UBound(greater) + 1) If Err.Number = 0 Then 'Do Nothing Else ReDim greater(0) End If greater(UBound(greater)) = data(i) On Error GoTo 0 End If Next QuickSortArray = QuickSortArray(less) & pivot & QuickSortArray(greater) End If End Function