VBA応用(ワークシートのSortメソッドを使わずに並べ替えを行なう。)

ワークシート上のソートは並べ替えで説明しましたが、場合によってはワークシートを使わずに並べ替えたいこともあると思います。

Sortメソッドを使わない利点！？単一ワークシート上のデータの並べ替えであればSortメソッドを使えば良いと思います。
ですが、外部のテキストなどのデータの並べ替えであったりすれば一旦ワークシートに取り込んで並べ替えてから再度テキストに書き出すという手間が掛かります。この他、数値と数字文字列が混在していたり、ワークシートに収容し切れない件数だったり、複数シートに分断されているとかで、Sortメソッドでは対応できないケースもあると思います。
Sortメソッドが使えるケースなのにあえてVBAで独自に記述しなさいということではありません。

例えばテキストデータを読み込んで、ワークシートにデータを貼り付ける前にテーブル変数に格納しているような場合です。
そのようなケースでの対応のサンプルと、合わせてワークシートのSortメソッドに比べて処理時間がどうなのかということを含めて比較できるように作りました。

(画像をクリックすると、このページのサンプルがダウンロードできます)
画面のようにボタンが縦に並んでおり、一番下(シートのクリア)を除いて上から順にクリックしていくと順に処理されてボタンの上に処理した秒数が表示されます。

「ランダム値を10000行分作成(A列)」
000001から999999までの値をランダムに算出し、10000行までA列にセットします。
以降、このA列の値を元にBからD列に各方式での並べ替えを行ないます。
「ワークシートのSortメソッド(B列)」
A1:A10000をB1:B10000に転記して、B1:B10000を並べ替えます。
「バブルソート(C列)」
マクロで並び替えの記述を行なう上で最も簡単に記述できる方法です。ですが件数が多い並べ替えには適しません。
「クイックソート(D列)」
マクロで並び替えの記述を行なう上で最も速い方法だと思います。並び替え範囲の中央の値を起点に大小判断して入れ替えを行ない、並び替え範囲を狭めながら再帰呼び出しで繰り返します。
「結果の正当性を確認」
10000行分の値が同じか、前行より小さくなることがないかのチェックで、エラーがあればその行番号を表示します。
「シートのクリア」
並び替えに使用した値と、処理結果を初期化します。

処理結果はこのような感じになります。
並び替えの処理結果

ご覧のようにSortメソッドが一番速い結果になりました。ですが、クイックソートの僅差であり１回配列変数に格納して並び替え、再度、配列変数からシートに戻していることを考えると問題ない速さだと言えます。
10000件のランダム値セットよりも速い結果になりました。
実際に比較してみたのは初めてで、私自身もビックリな結果でした。(ビックリなのはクイックソートの速さです)

「ワークシートのSortメソッド(B列)」
記述はこのようになります。以前に並べ替えで説明しているものと何ら変わりません。


'***************************************************************************************************
'* 処理名　：SORT_BY_SHEET
'* 機能　　：ワークシートのSORTメソッドでの並べ替え → B列
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub SORT_BY_SHEET()
    '-----------------------------------------------------------------------------------------------
    Dim objStrTime As SYSTEMTIME                                    ' 処理開始時間
    ' 画面描画停止
    Call GP_StopScUpd(objStrTime)
    '---------------------------------------------------------------------------
    ' 値をB列に転記
    Range(g_cnsB).Value = Range(g_cnsA).Value
    ' 並べ替え
    Range(g_cnsB).Sort Key1:=Range("B1"), _
                       Order1:=xlAscending, _
                       Header:=xlNo, _
                       Orientation:=xlTopToBottom, _
                       OrderCustom:=1
    '---------------------------------------------------------------------------
    ' 画面描画再開
    Call GP_StartScUpd(7, objStrTime)
End Sub

「バブルソート(C列)」
記述はこのようになります。このように実際の並び替えの部分は10行程度で済んでしまい、記述にも画一性があるので転用も簡単です。


'***************************************************************************************************
'* 処理名　：SORT_BY_BUBBLE
'* 機能　　：バブルSORTでの並べ替え → C列
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub SORT_BY_BUBBLE()
    '-----------------------------------------------------------------------------------------------
    Dim objStrTime As SYSTEMTIME                                    ' 処理開始時間
    Dim lngIx1 As Long                                              ' テーブルINDEX
    Dim lngIx2 As Long                                              ' テーブルINDEX
    Dim lngIxMax As Long                                            ' テーブルINDEX上限
    Dim tblNum As Variant                                           ' セル範囲要素テーブル
    Dim tmpNum As String                                            ' 差し替えWORK
    ' 画面描画停止
    Call GP_StopScUpd(objStrTime)
    '---------------------------------------------------------------------------
    ' テーブルに格納(Array)
    tblNum = Range(g_cnsA).Value
    lngIxMax = UBound(tblNum)
    ' 並べ替え
    lngIx1 = 1
    ' 全テーブルの前からのループ
    Do While lngIx1 < lngIxMax                                  ' ①
        lngIx2 = lngIxMax
        ' 終端から現在位置手前までのループ
        Do While lngIx2 > lngIx1                                ' ②
            ' 差し替え判定
            If tblNum(lngIx2, 1) < tblNum(lngIx1, 1) Then       ' ③
                ' 差し替え
                tmpNum = tblNum(lngIx2, 1)
                tblNum(lngIx2, 1) = tblNum(lngIx1, 1)           ' ④
                tblNum(lngIx1, 1) = tmpNum
            End If
            ' 前へ
            lngIx2 = lngIx2 - 1
        Loop
        ' 次へ
        lngIx1 = lngIx1 + 1
    Loop
    ' テーブルをC列に転記
    Range(g_cnsC).Value = tblNum
    '---------------------------------------------------------------------------
    ' 画面描画再開
    Call GP_StartScUpd(8, objStrTime)
End Sub

A列の10000件を配列変数に格納するのは、今回はVariant型の機能に任せてArray関数での送り出しと同様に1行で決着をつけています。

№	概略説明
①	lngIx1が指しているのは、配列の先頭から最終の1件前までです。1件ずつループさせます。
②	lngIx2は、lngIx1のループ内で毎回、最終値から逆にlngIx1の1件後までを1件ずつ繰り返しながら戻ります。
③	lngIx2の方が後ろ側に位置するので、この値がlngIx1が指している位置の値より小さい場合は入れ替え対象であると判断します。
④	この3行が入れ替えの作業の実体です。まずlngIx2が指している位置の値を一時変数に格納します。次にlngIx2が指している位置にlngIx1が指している位置の値を書き込みます。最後にlngIx1が指している位置に一時変数に格納していた値をセットすれば入れ替え完了です。

このように記述は簡単ですが、並び替えの方法の中では明らかに一番遅いです。
並び替え後は、配列をセル範囲に1行で移送できます。(但し配列要素数が同じでないと不可)

「クイックソート(D列)」
記述はこのようになります。これは並び替えの呼び出し部分です。


'***************************************************************************************************
'* 処理名　：SORT_BY_QUICK
'* 機能　　：クイックSORTでの並べ替え → D列
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub SORT_BY_QUICK()
    '-----------------------------------------------------------------------------------------------
    Dim objStrTime As SYSTEMTIME                                    ' 処理開始時間
    Dim lngIxMin As Long                                            ' 並び替え要素下限INDEX
    Dim lngIxMax As Long                                            ' 並び替え要素上限INDEX
    Dim tblNum As Variant                                           ' セル範囲要素テーブル
    ' 画面描画停止
    Call GP_StopScUpd(objStrTime)
    ' テーブルに格納(Array)
    tblNum = Range(g_cnsA).Value
    lngIxMin = LBound(tblNum)
    lngIxMax = UBound(tblNum)
    '---------------------------------------------------------------------------
    ' クイックSORT本体の呼び出し
    Call GP_SortByQuick(tblNum, lngIxMin, lngIxMax)
    ' テーブルをC列に転記
    Range(g_cnsD).Value = tblNum
    '---------------------------------------------------------------------------
    ' 画面描画再開
    Call GP_StartScUpd(9, objStrTime)
End Sub

A列の内容を配列変数に取り込むのと、処理結果をセル範囲に返すのは前項と何ら変わりはありません。

再帰呼び出しを行なうため、並び替えの主プロシージャは下のプロシージャになります。


'***************************************************************************************************
'   ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名　：GP_SortByQuick
'* 機能　　：クイックSORT本体(再帰呼び出しがあるため起動処理と分離)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = セル範囲要素テーブル(Variant)               ※Ref参照
'* 　　　　　Arg2 = 並び替え要素下限INDEX(Long)
'* 　　　　　Arg3 = 並び替え要素上限INDEX(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：本処理は再帰動作
'* 注意事項：
'***************************************************************************************************
Private Sub GP_SortByQuick(ByRef tblNum As Variant, ByVal lngIxMin As Long, ByVal lngIxMax As Long)
    '-----------------------------------------------------------------------------------------------
    Dim lngIxC As Long                                              ' 中央の位置
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim lngIx2 As Long                                              ' テーブルINDEX
    Dim tmpNum1 As Variant                                          ' 中央の値
    Dim tmpNum2 As Variant                                          ' 入替用WORK
    ' 終了判定
    If lngIxMin >= lngIxMax Then Exit Sub                       ' ①
    ' 中央の位置を算出
    lngIxC = (lngIxMin + lngIxMax) \ 2                          ' ②
    ' 中央の値をTEMP1取得
    tmpNum1 = tblNum(lngIxC, 1)                                 ' ③
    ' 開始位置要素を中央にセット
    tblNum(lngIxC, 1) = tblNum(lngIxMin, 1)                     ' ④
    lngIx2 = lngIxMin
    '---------------------------------------------------------------------------
    lngIx = lngIxMin + 1
    Do While lngIx <= lngIxMax                                  ' ⑤
        If tblNum(lngIx, 1) < tmpNum1 Then                      ' ⑥
            ' 値がTEMP1より小さければ基準値を入れ替え
            lngIx2 = lngIx2 + 1                                 ' ⑦
            tmpNum2 = tblNum(lngIx2, 1)
            tblNum(lngIx2, 1) = tblNum(lngIx, 1)
            tblNum(lngIx, 1) = tmpNum2
        End If
        lngIx = lngIx + 1
    Loop
    tblNum(lngIxMin, 1) = tblNum(lngIx2, 1)                     ' ⑧
    tblNum(lngIx2, 1) = tmpNum1
    '---------------------------------------------------------------------------
    ' 分割前半を再帰呼び出しでSORT
    Call GP_SortByQuick(tblNum, lngIxMin, lngIx2 - 1)           ' ⑨
    '---------------------------------------------------------------------------
    ' 分割後半を再帰呼び出しでSORT
    Call GP_SortByQuick(tblNum, lngIx2 + 1, lngIxMax)           ' ⑩
End Sub

再帰呼び出しとは、1つのプロシージャから再度その自身のプロシージャを呼び出すことを指します。

№	概略説明
①	繰り返し再帰で呼び出されるため、開始／終了のインデックス位置から並び替え完了を判断して終了する。
②	開始／終了のインデックス位置の中央位置を算出。
③	中央位置の値を別の変数に確保しておく。
④	中央位置に開始位置の値をセットする。
⑤	開始位置の次から終了位置まで繰り返す。
⑥	元中央位置にあった値と比べて、その位置にあった値が小さいか判断する。
⑦	⑥で小さいと判断されれば、開始位置の次の位置から順になるように入れ替えを行なう。
⑧	最後に入れ替えた値を開始位置にセットし、別の変数に確保していた値を最後に入れ替えた位置にセットする。
⑨	中央位置の手前までの範囲を指定して再帰呼び出しを行なう。
⑩	中央位置の次から終了位置までの範囲を指定して再帰呼び出しを行なう。

処理は何重にも入れ子になって動作することになりますが、最終的にはバブルソートよりははるかに速い時間で処理が行なわれます。

「結果の正当性を確認」
これまでの並べ替えの処理の結果の正当性を確認します。


'***************************************************************************************************
'* 処理名　：CHECK_RESULT
'* 機能　　：3種類のSORT結果が等しいか検証
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub CHECK_RESULT()
    '-----------------------------------------------------------------------------------------------
    Dim lngRow As Long                                              ' 行INDEX
    ' 全件ループ
    For lngRow = 1 To 10000
        ' 各列が一致していなければエラー
        If Not ((Cells(lngRow, 2).Value = Cells(lngRow, 3).Value) And _
                (Cells(lngRow, 2).Value = Cells(lngRow, 4).Value) And _
                (Cells(lngRow, 3).Value = Cells(lngRow, 4).Value)) Then
            MsgBox lngRow & "行目が一致していません。", vbExclamation
            Exit Sub
        End If
        ' 前行より大きくなければエラー
        If lngRow > 1 Then
            If Cells(lngRow, 2).Value < Cells(lngRow - 1, 2).Value Then
                MsgBox lngRow & "行目は前行より小さい値です。", vbExclamation
                Exit Sub
            End If
        End If
    Next lngRow
    '---------------------------------------------------------------------------
    MsgBox "並べ替え結果に異常はありません。", vbInformation
End Sub

1行目から10000行目までを順次繰り返して、以下の検証を行ないます。
・B列、C列、D列の値に不一致がないか。
・1行目以降であれば、前行より小さい値になっていることがないか。