[ExcelVBA] 再帰処理 - QuickSort

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 21日目

前日に引き続き、再帰処理の例をあげてみます。
今度はQuickSortです。
この例では、配列のデータは整数のみ限定ということで書いています。

Option Explicit

Sub QuickSort(ByRef Data As Variant, Optional ByVal S As Integer = 0, Optional ByVal E As Integer = -1)
    Dim BaseValue  As Long
    Dim ChangeData As Long
    Dim TempEnd    As Long
    Dim TempStart  As Long
    
    If E = -1 Then E = UBound(Data)
    
    '基準の値を決定(ひとまず中間の要素値を基準とする)
    BaseValue = CLng(Data(Int((S + E) / 2)))

    TempStart = S
    TempEnd = E
    Do
        '基準値より大きい値の要素を探す
        '該当するものがなければ基準値の要素でStopする
        Do While CLng(Data(TempStart)) < BaseValue
            TempStart = TempStart + 1
        Loop
        
        '基準値より小さい値の要素を探す
        '該当するものがなければ基準値の要素でStopする
        Do While BaseValue < CLng(Data(TempEnd))
            TempEnd = TempEnd - 1
        Loop
    
        'Start側の要素数がEnd側の要素数と一致した場合
        '入れ替える物がなかったためこのループは終了とする
        If TempEnd <= TempStart Then Exit Do
    
        'データを入れ替える
        ChangeData = Data(TempStart)
        Data(TempStart) = Data(TempEnd)
        Data(TempEnd) = ChangeData
        
        '範囲をそれぞれ一つずつ狭める
        TempStart = TempStart + 1
        TempEnd = TempEnd - 1
    Loop
    
    '状況によってさらにソートを続ける
    If S < TempStart - 1 Then Call QuickSort(Data, S, TempStart - 1)
    If TempEnd + 1 < E Then Call QuickSort(Data, TempEnd + 1, E)
End Sub


Sub SampleCode()
    Dim Data As Variant
    
    Data = Array(34, 96, 43, 78, 35, 69, 6, 3, 50, 34, 55, 44)
    
    Call QuickSort(Data)
    Debug.Print Join(Data, ",")
End Sub

ただし、QuickSortは安定ソートでないため 一次元配列に対してしか使うことができず 二次元配列には別のソートアルゴリズムを使う必要があります。

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar