Ver.1.2.xリリースいたしました！(Ver.1.1.0は諸事情によりお蔵入り…)

以下のプロシージャを新規で追加しました、今回は開発するシステムの堅牢性を向上させることを目的としたプロシージャを多数作ってみました。
まだまだ作りたいものはありますのでのんびり作っていきたいと思います。

プロシージャ名	概要
SortArray	1次元配列の内容を昇順または降順にソート
ShowAllCells	対象シートの全行・前列を表示
AutoCellToArray	対象シートのセルの内容を自動で配列に変換
GetDataArea	シートのデータ範囲のアドレスを自動取得
AutoDeleteBlankRows / AutoDeleteBlankColumns	空白行/列を削除
GetFiscalYear / ToWareki	日付表記処理
KanaConv / AtoZConv / NumConv	全角⇔半角変換
FileSafe / SheetSafe	禁則文字を代替文字に変換
MoveItem	ファイル移動、必要により元フォルダにショートカット生成
ConvertOneDrivePath	OneDrive上のパスを物理ディレクトリに変換
以下のリンクから `.bas` ファイルをダウンロードできます（zipファイル）

さて、今回紹介するプロシージャは

プロシージャ名	概要
SortArray	1次元配列の内容を昇順または降順にソート

業務においてデータをソートすることってよくありますよね、今回1次元配列限定ではありますが配列の中身を昇順または降順にソートができ、さらに入力の配列の規模によって適したソート方法を自動で切り替えるというプロシージャを(ChatGPTの力を借りながら)作ってみました。

SortArray

Function SortArray(originalArray As Variant, Optional sortMethod As Long = 1) As Variant
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜1次元配列を昇順または降順でソート(配列規模によってソート方法を自動で変更)
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜originalArray - ソート対象の1次元配列
'　引数２　｜sortMethod - ソート方法(1:昇順,2:降順,デフォルトは1)(Long型)
'------------------------------------------------------------------------------------------------------------------------------
'　戻り値　｜Variant型 - ソート済み1次元配列(インデックスは1開始)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.1.0(2025/06/14:新規)
'　　　　　｜Ver.1.2.0(2025/06/16:大規模データに対し自動でマージソートを適用する機能を追加)
'------------------------------------------------------------------------------------------------------------------------------
    
    'ユーザー定義エラー
    If IsArray(originalArray) <> True Then
        Err.Raise vbObjectError + 1001, "SortArray", "引数は1次元配列を指定してください"
    End If
    If sortMethod <> 1 And sortMethod <> 2 Then
        Err.Raise vbObjectError + 1002, "SortArray", "引数は1(昇順)または2(降順)にしてください"
    End If
    
    Dim iLoop           As Long 'ループカウンタ
    Dim jLoop           As Long 'ループカウンタ
    Dim kLoop           As Long 'ループカウンタ
    Dim elemCount       As Long '空白を考慮した配列要素数
    Dim halfNum         As Long '配列要素数÷2
    Dim leftArr()       As Variant '分割後配列
    Dim rightArr()      As Variant '分割後配列
    Dim mergedArr()     As Variant '結合用配列
    Dim tempNumber      As Variant '要素入れ替え用変数
    
    '要素数の取得
    elemCount = UBound(originalArray) - LBound(originalArray) + 1
    
    '要素数が0または1の場合そのままの値を返す
    If elemCount <= 1 Then
        SortArray = originalArray
        Exit Function
    End If
    
    Select Case True
        'バブルソートを適用
        Case elemCount <= 50
            Select Case sortMethod
                '昇順にソート
                Case 1
                    For iLoop = LBound(originalArray) To UBound(originalArray) - 1
                        For jLoop = iLoop + 1 To UBound(originalArray)
                            If originalArray(iLoop) > originalArray(jLoop) Then
                                tempNumber = originalArray(iLoop)
                                originalArray(iLoop) = originalArray(jLoop)
                                originalArray(jLoop) = tempNumber
                            End If
                        Next
                    Next iLoop
                '降順にソート
                Case 2
                    For iLoop = LBound(originalArray) To UBound(originalArray) - 1
                        For jLoop = iLoop + 1 To UBound(originalArray)
                            If originalArray(iLoop) < originalArray(jLoop) Then
                                tempNumber = originalArray(iLoop)
                                originalArray(iLoop) = originalArray(jLoop)
                                originalArray(jLoop) = tempNumber
                            End If
                        Next
                    Next iLoop
            End Select
            
            SortArray = originalArray
        'マージソートを適用
        Case elemCount > 50
            '元配列の分割
            halfNum = elemCount \ 2
            ReDim leftArr(1 To halfNum)
            ReDim rightArr(1 To elemCount - halfNum)
            
            For iLoop = 1 To halfNum
                leftArr(iLoop) = originalArray(LBound(originalArray) + iLoop - 1)
            Next iLoop
            For iLoop = 1 To elemCount - halfNum
                rightArr(iLoop) = originalArray(LBound(originalArray) + halfNum + iLoop - 1)
            Next iLoop
            
            '再帰ソート
            leftArr = SortArray(leftArr, sortMethod)
            rightArr = SortArray(rightArr, sortMethod)
            
            '配列の結合
            ReDim mergedArr(1 To elemCount)
            iLoop = 1
            jLoop = 1
            kLoop = 1
            Do While iLoop <= UBound(leftArr) And jLoop <= UBound(rightArr)
                Select Case sortMethod
                    '昇順にソート
                    Case 1
                        If leftArr(iLoop) <= rightArr(jLoop) Then
                            mergedArr(kLoop) = leftArr(iLoop)
                            iLoop = iLoop + 1
                        Else
                            mergedArr(kLoop) = rightArr(jLoop)
                            jLoop = jLoop + 1
                        End If
                    '降順にソート
                    Case 2
                        If leftArr(iLoop) > rightArr(jLoop) Then
                            mergedArr(kLoop) = leftArr(iLoop)
                            iLoop = iLoop + 1
                        Else
                            mergedArr(kLoop) = rightArr(jLoop)
                            jLoop = jLoop + 1
                        End If
                End Select
                kLoop = kLoop + 1
            Loop
            
            Do While iLoop <= UBound(leftArr)
                mergedArr(kLoop) = leftArr(iLoop)
                iLoop = iLoop + 1
                kLoop = kLoop + 1
            Loop
            Do While jLoop <= UBound(rightArr)
                mergedArr(kLoop) = rightArr(jLoop)
                jLoop = jLoop + 1
                kLoop = kLoop + 1
            Loop
            
            SortArray = mergedArr
    End Select
    
End Function

本プロシージャはバブルソートという方法とマージソートという2つの方法を採用しております。ソートのアルゴリズムに関しては省略させていただきますが、ざっくりバブルソートは小規模データ向き、マージソートは大規模データ向きを覚えていただければ十分です！この記事のためにソートのアルゴリズムについても調べましたが、いろいろあるんですね…勉強になりました。

クイックソートやマージソートといった手法は少ない手数でソートを完了できるという点が強みではありますが、アルゴリズムの都合上メモリに負荷がかかるため小規模データであればソートの手数は多いですが、バブルソートのようなシンプルなアルゴリズムのほうが良かったりするのだそうです。
「だったらデータの規模を自動で判断させて適切なアルゴリズムを適用してもらえばユーザーは楽なのでは？」というものぐさな発想のもと生まれたのがこのプロシージャです(笑)

動作解説

サンプルプログラムとその動作結果を示します、配列aに対して昇順と降順のソートをかけてみました。

Sub Main()
    
    Dim a As Variant '元配列
    Dim b As Variant '昇順
    Dim c As Variant '降順
    Dim i As Long 'ループカウンタ
    
    a = Array(1, "あいうえお", 5, 3, 8, "かきくけこ", 6, 9, 0)
    b = SortArray(a, 1)
    c = SortArray(a, 2)
    
    Debug.Print "昇順ソート"
    For i = LBound(a) To UBound(a)
        Debug.Print b(i)
    Next i
    
    Debug.Print "------------------"
    Debug.Print "降順ソート"
    For i = LBound(a) To UBound(a)
        Debug.Print c(i)
    Next i
    
End Sub

こちらのサンプルに対する出力は以下のようになります。

ぜひ用途に合わせて使ってみてください！ソートや配列に関してまたアイデアが浮かんできましたら順次追加していこうと思います！

直感！VBAシリーズ記事一覧

もしよろしければ他の記事もご覧ください！