hex309’s diary

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

挿入ソート(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