Excel VBA：シェルソートで配列をソートする｜間隔の決め方

シェルソートを使い配列をソートするVBAのコードを掲載しています。

Homeに戻る > Excel プログラムのTipsへ

シェルソートとは、比較的低速だがコードはシンプルだと言われているソート方法です。

低速と言っても大量データでないかぎり差はありません。

シェルソートの方法は、比較するデータの間隔を決めソートを行い、しだいにその間隔を狭めていき最後に隣同士を比較します。

最初の間隔の決め方は下のExSortプロシージャを参照してください。

ここでは分かり易いように番号付きの文字列を配列にセットし、ソートを行います。

関連する記事として、Sortメソッドを使った「家計簿ソフトを作ってみよう Step 10　日付と費目でソートする」を掲載していますので参照してください。

Excel VBAでシェルソートを使い配列をソートするコードの解説

■ コマンドボタン1のクリックイベント

インデックスが4の配列を宣言します。
配列に番号付きの文字列を格納します。
Forループを使用し、ソート前の配列のデータをセルに表示します。
引数に配列をセットしExSortを呼び出します。
Forループを使用し、ソート後の配列のデータをセルに表示します。

■ ExSortプロシージャ

配列の最小インデックスを間隔hにセットします。
Forループで配列の最大インデックスまでループします。
間隔は、「h×3+1」で加算します。
Doループでソートを実行します。
間隔hを3で割ります。
Forループの開始値を間隔＋配列の最小インデックス、終了値を配列の最大インデックスにしループします。
Doループ配列データを比較します。
比較し配列データが小さければデータを交換します。
これを繰り返し、間隔がインデックスの最小値になれば完了です。

シェルソートで使い配列をソートするコード

Option Explicit

'Excel VBAで配列のソート
Private Sub ExSort(sary() As String)
    Dim i As Long
    Dim j As Long
    Dim h As Long
    Dim temp As String

    '交換処理の間隔を決める
    h = LBound(sary())
    For i = 1 To UBound(sary()) - 1
         h = h * 3 + 1
    Next

    Do
        h = h / 3
        For i = h + LBound(sary()) To UBound(sary())
            temp = sary(i)
            j = i
            '交換
            Do While sary(j - h) > temp
                sary(j) = sary(j - h)
                j = j - h
                If j < h Then
                    Exit Do
                End If
            Loop
            sary(j) = temp
        Next
    Loop Until h = LBound(sary())

End Sub

Private Sub CommandButton1_Click()
    Dim jyuutaku(4) As String
    Dim i As Integer

    jyuutaku(0) = "3:床"
    jyuutaku(1) = "1:天井"
    jyuutaku(2) = "4:玄関"
    jyuutaku(3) = "2:窓"
    jyuutaku(4) = "5:水まわり"
    'ソート前の表示
    For i = 0 To UBound(jyuutaku)
        Cells(7 + i, 2) = jyuutaku(i)
    Next

    ExSort jyuutaku

    'ソート結果の表示
    For i = 0 To UBound(jyuutaku)
        Cells(7 + i, 4) = jyuutaku(i)
    Next
End Sub

実行結果のExcelシート

B列がソート前、D列がソート結果です。

Homeに戻る > Excel プログラムのTipsへ

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します