VBA 一次元配列のソート

バブルソート

  • 隣同士の値を比較、必要があれば入れ替えを繰り返して整列する
Sub zsBubbleSort1(ByRef dataAry() As Variant)
    Dim temp As Variant
    Dim i As Long, j As Long
    For i = UBound(dataAry) To LBound(dataAry) Step -1
        For j = LBound(dataAry) To i - 1
            If dataAry(j) > dataAry(j + 1) Then
                temp = dataAry(j)
                dataAry(j) = dataAry(j + 1)
                dataAry(j + 1) = temp
            End If
        Next j
    Next i
End Sub

’実行テスト
Sub SortTest1()
    Dim dataArray() As Variant
    dataArray = Array(3, 5, 1, 2, 4, 6, 9, 8, 7)
    Call zsBubbleSort1(dataArray)
    
    Dim i As Long
    For i = LBound(dataArray) To UBound(dataArray)
        Debug.Print i
    Next i
End Sub

挿入ソート

  • 左から順番に要素を比較しながら入れ替えを繰り返して整列する
Sub zsInsertionSort1(ByRef dataAry() As Variant)
    Dim i As Long, j As Long
    Dim startData As Long, endData As Long
    Dim temp As Long
    startData = LBound(dataAry)
    endData = UBound(dataAry)

    For i = LBound(dataAry) + 1 To UBound(dataAry)
        temp = dataAry(i)
        For j = i - 1 To UBound(dataAry) Step -1
            If dataAry(j) > temp Then
                dataAry(j + 1) = dataAry(j)
            Else
                Exit For
            End If
        Next j
        dataAry(j + 1) = temp
    Next i
End Sub

’実行テスト用
Sub SortTest2()
    Dim dataArray() As Variant
    dataArray = Array(3, 5, 1, 2, 4, 6, 9, 8, 7)
    Call zsInsertionSort1(dataArray)
    
    Dim i As Long
    For i = LBound(dataArray) To UBound(dataArray)
        Debug.Print i
    Next i
End Sub

コメント