[ExcelVBA] 再帰処理 - QuickSort

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

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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub QuickSort(ByRef Data As Variant, Optional ByVal S As Integer = 0, Optional ByVal E As Integer = -1)  
4.     Dim BaseValue  As Long  
5.     Dim ChangeData As Long  
6.     Dim TempEnd    As Long  
7.     Dim TempStart  As Long  
8.       
9.     If E = -1 Then E = UBound(Data)  
10.       
11.     '基準の値を決定(ひとまず中間の要素値を基準とする)  
12.     BaseValue = CLng(Data(Int((S + E) / 2)))  
13.   
14.     TempStart = S  
15.     TempEnd = E  
16.     Do  
17.         '基準値より大きい値の要素を探す  
18.         '該当するものがなければ基準値の要素でStopする  
19.         Do While CLng(Data(TempStart)) < BaseValue  
20.             TempStart = TempStart + 1  
21.         Loop  
22.           
23.         '基準値より小さい値の要素を探す  
24.         '該当するものがなければ基準値の要素でStopする  
25.         Do While BaseValue < CLng(Data(TempEnd))  
26.             TempEnd = TempEnd - 1  
27.         Loop  
28.       
29.         'Start側の要素数がEnd側の要素数と一致した場合  
30.         '入れ替える物がなかったためこのループは終了とする  
31.         If TempEnd <= TempStart Then Exit Do  
32.       
33.         'データを入れ替える  
34.         ChangeData = Data(TempStart)  
35.         Data(TempStart) = Data(TempEnd)  
36.         Data(TempEnd) = ChangeData  
37.           
38.         '範囲をそれぞれ一つずつ狭める  
39.         TempStart = TempStart + 1  
40.         TempEnd = TempEnd - 1  
41.     Loop  
42.       
43.     '状況によってさらにソートを続ける  
44.     If S < TempStart - 1 Then Call QuickSort(Data, S, TempStart - 1)  
45.     If TempEnd + 1 < E Then Call QuickSort(Data, TempEnd + 1, E)  
46. End Sub  
47.   
48.   
49. Sub SampleCode()  
50.     Dim Data As Variant  
51.       
52.     Data = Array(34, 96, 43, 78, 35, 69, 6, 3, 50, 34, 55, 44)  
53.       
54.     Call QuickSort(Data)  
55.     Debug.Print Join(Data, ",")  
56. End Sub  

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