クイックソート（配列バージョン）

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

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

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

二分探索（VBA）

今回は、二分探索です。

配列の要素を検索して、指定した値が配列の何番目にあるか調べます。
相変わらずコメント無くてすみません。

Private Sub BinarySearchTest()
    Dim vList(1 To 5) As Long
    
    vList(1) = 1
    vList(2) = 5
    vList(3) = 10
    vList(4) = 14
    vList(5) = 20
    
    Debug.Print BinarySearch(vList, 10)
End Sub

Private Function BinarySearch(ByRef vList() As Long, ByVal vTarget As Long) As Long
    Dim vHigh As Long
    Dim vRow As Long
    Dim vMid As Long
    
    vHigh = UBound(vList)
    vRow = LBound(vList)
    
    Do Until vRow > vHigh
        vMid = (vHigh + vRow) / 2
        If vList(vMid) = vTarget Then
            BinarySearch = vMid
            Exit Do
        ElseIf vList(vMid) < vTarget Then
            vRow = vRow + 1
        Else
            vHigh = vMid - 1
        End If
    Loop
End Function

挿入ソート（VBA）

先日、クイックソートを載せたので、今回は挿入ソートです。
今回もCollection使ってます。

コメントが無いのはすみません。

Private Sub InsertionSortTest()
    Dim temp As Collection
    Dim i As Long
    
    Set temp = New Collection
    temp.Add 4
    temp.Add 3
    temp.Add 2
    temp.Add 1
    
    Set temp = InsertionSort(temp)
    For i = 1 To temp.Count
        Debug.Print temp.Item(i)
    Next
    
End Sub

Private Function InsertionSort(ByVal data As Collection) As Collection
    Dim temp As Variant
    Dim i As Long, j As Long
    
    For i = 2 To data.Count
        j = i
        Do While j > 1
            If data.Item(j - 1) < data.Item(i) Then
                Exit Do
            End If
            j = j - 1
        Loop
        
        If i = j Then
            'Do Nothing
        Else
            temp = data.Item(i)
            data.Remove i
            data.Add temp, , Before:=(j)
        End If
    Next
        
    Set InsertionSort = data
End Function

アルゴリズムのお勉強

頭のトレーニング用に最近買った本です。 

なっとく！アルゴリズム

 この書籍、なかなか読みやすく分かりやすかったです。

サンプルコードはPythonで書かれてますが、Python知らなくても読めるでしょう。

さて、この書籍で紹介されていたコードを参考にちょっとVBAで書いてみました。

クイックソートです。

Private Sub QuickSortCollectionTest()
    Dim temp As Variant
    Dim data As Collection
    Dim i As Long

    Set data = New Collection
    data.Add 6
    data.Add 5
    data.Add 2
    data.Add 1

    Debug.Print QuickSortCollection(data)
End Sub

Private Function QuickSortCollection(ByVal data As Collection) As Variant
    Dim pivot As Variant
    Dim less As Collection
    Dim greater As Collection
    Dim i As Long

    Set less = New Collection
    Set greater = New Collection

    If data.Count = 0 Then
        QuickSortCollection = vbNullString
    ElseIf data.Count < 2 Then
        QuickSortCollection = data.Item(1)
    Else
        pivot = data.Item(1)
        For i = 2 To data.Count
            If data.Item(i) <= pivot Then
                less.Add data.Item(i)
            ElseIf data.Item(i) > pivot Then
                greater.Add data.Item(i)
            End If
        Next
        QuickSortCollection = QuickSortCollection(less) & pivot & QuickSortCollection(greater)
    End If
End Function

ここでは、配列ではなくてCollectionを使っています。もちろん、配列で書いてもいいんで、配列バージョンを書いたらアップします（いつになるかわかりませんが）。

今日から始めます

最近、勉強してもすぐ忘れるので、備忘録的に始めます。

VBAネタが多くなりそうです。