hex309’s diary

備忘録としてぼちぼちやります。VBAネタが多くなりそうです

クイックソート(配列バージョン)

始めたばかりですが、息切れ始まった感じです。
とりあえず、クイックソートの配列バージョンです。

正直、エラー処理などもっとスマートにできる気がしますが、公開します。

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