名前の分からないソート

前回は、VBA100本ノックで「シートの並び替え」に挑戦した。
infoment.hatenablog.com
今回は、問題を解きながら思いついたことを一つ。

バブルソートやクイックソートがある中で、こんな並べ替えを思いついた。

1. 並べ替えたい 配列Ａ内の要素のうち、最大値iMaxを求めておく。
2. 配列Ａと同じサイズの、配列Ｂを準備する。
3. 配列Ａ内の要素を先頭から確認し、同配列内の最小値と等しいとき
   配列Ｂに順次移植する。
4. 移植した値は、再び最小値として検知されぬよう、配列Ａ内で
   iMax+1に置き換えておく。
5. 再び配列Ａの先頭から、同じ処理を繰り返す。

これにより最終的に、以下の結果が得られる。

• 配列Ａ内の要素は全て、iMax+1となる。
• 配列Ｂは、元の配列Ａをソートした結果となる。

上記をコード化したものが、こちら。

Function 名無しソート(ByVal source_array As Variant) As Variant
    ' ソート後の配列
    Dim DestinationArray As Variant
    ' 元の配列とサイズを揃える。
        DestinationArray = source_array
    ' 配列の最大値を求める。
    Dim iMax As Variant
        iMax = WorksheetFunction.Max(source_array)
    Dim i As Long
    Dim j As Long
        j = LBound(source_array)
        
    ' 配列の中で一番小さな値を順に、ソート後の配列にセットする。
    ' セット後、元の配列には元の最大値+1をセットすることで、
    ' 順番に小さな値を抽出することができる。
    Do
        For i = LBound(source_array) To UBound(source_array)
            ' 最小値判定。
            If source_array(i) = WorksheetFunction.Min(source_array) Then
                DestinationArray(j) = source_array(i)
                source_array(i) = iMax + 1
                j = j + 1
                If j > UBound(source_array) Then
                    Exit Do
                Else
                    Exit For
                End If
            End If
        Next
    Loop Until i = UBound(source_array) + 1
    
    名無しソート = DestinationArray
End Function

テスト結果は良好。但し文字列などが要素内にあると正しい結果が返らないため、万能ではない。今回は実験的な試みであったため、良しとしよう。

ところで、私が思いつくぐらいだから、上記は既に世の中で誰かが考案した方法に違いない。ただ如何せん、名前がわからない。わからないので、関数名も「名無しソート」とした。

もしこの手法名に「バブルソート」のような名前がついていて、それをご存じの方居られましたら、コメント欄までよろしくお願いします。

参考まで。