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シリーズ記事一覧
もしよろしければ他の記事もご覧ください！