ヒープソートのサンプルVBA：1次元/2次元配列対応版

公開日：2025-10-16　最終更新日：2025-10-16

ヒープソートのサンプルVBA：1次元/2次元配列対応版

ヒープという木構造を利用するソートアルゴリズム『ヒープソート』を、生成AIで作成しました。
本記事のVBAコードは、AIの出力をもとに構成しています。また、説明文の多くも生成AIが作成した文章を転用しています。

使用したAIは以下になります。

・Gemini
・ChatGPT
・CLlaude

筆者が生成AIにVBAを作成してもらう時の基本的なやり方

・Geminiに（プロンプト）指示
・動作確認
・コードをChatGptに入れて改善点の指摘と改善後のコード作成
・改善後のコードをClaudeに入れて改善点の指摘と改善後のコード作成
・改善後のコードをGeminiに入れてさらに改善
納得いくまで繰り返す。
※AIの利用順序は適宜変更しています。

ページ内目次

ヒープソートとは
ヒープソート：1次元配列用のVBAコード
ヒープソート：1次元配列用の実行テスト
ヒープソート：1次元/2次元配列対応版のVBAコード
ヒープソート：1次元/2次元配列対応版の実行テスト
サイト内関連ページ

ヒープソートとは

ヒープソートの簡単な説明

ヒープソートは、ヒープという特殊な木構造（ツリー構造）を利用するソートアルゴリズムです。
ヒープ構造では、親ノードが常に子ノードより大きい（または小さい）というルール（ヒープ条件）が保たれます。
このルールを利用して、配列の先頭（ルート）から最大（または最小）の要素を繰り返し取り出し、配列の末尾から順番に並べていくことでソートを完了します。

特徴と他のアルゴリズムとの比較

ヒープソートの特徴は、最悪の場合でも計算量が安定しており、処理速度が落ちにくいことです。

特徴	説明
計算量の安定性	O(nlogn) の計算量を最悪の場合でも保証します。これはクイックソート（最悪 O(n2)）よりも優れています。
追加メモリ	ソート中にデータを格納するための追加の作業領域がほとんど不要です（O(1)）。これはマージソート（O(n) の追加メモリが必要）よりも優れています。
不安定なソート	同じ値を持つ要素の相対的な順序がソート後に変わってしまう（不安定）ことがあります。これはマージソート（安定）よりも劣ります。

他の主要なソートアルゴリズムとの比較

アルゴリズム	計算量（平均/最悪）	メモリ使用量	安定性	適した用途
ヒープソート	O(nlogn) / O(nlogn)	O(1) (少ない)	不安定	安定した性能が必要で、メモリ使用量を抑えたい場合に適しています。
クイックソート	O(nlogn) / O(n2)	O(logn) (少ない)	不安定	平均的には最も速い。実用上のソートによく使われる。
マージソート	O(nlogn) / O(nlogn)	O(n) (多い)	安定	安定性が要求される場合や、外部メモリでのソート。
バブルソート	O(n2) / O(n2)	O(1) (少ない)	安定	要素数が非常に少ない場合や教育用。実用性は低い。

ヒープソートの手順

フェーズ1: 最大ヒープの構築

配列を二分木として見る
- 配列のインデックス i の要素に対して
- 左の子: インデックス 2i + 1
- 右の子: インデックス 2i + 2
- 親: インデックス (i - 1) / 2
最後の親ノードから順にヒープ化
- 最後の親ノードはインデックス floor(n/2) - 1
- そこから逆順（インデックス 0 まで）に各ノードをヒープ化
ヒープ化の処理
- 親ノードと左右の子ノードを比較
- 3つの中で最大の値を見つける
- 親が最大でなければ、最大の子と交換
- 交換した位置から再帰的にヒープ化を続ける

フェーズ2: ソート

ルート（最大値）を取り出す
- 配列の先頭（最大値）と末尾を交換
- 末尾の要素は確定（ソート済み）
ヒープサイズを1減らす
- 確定した末尾を除外してヒープを再構築
再びヒープ化
- ルート（新しく先頭に来た要素）からヒープ化を実行
繰り返し
- 手順4～6を、ヒープサイズが1になるまで繰り返す
完了
- 全ての要素が昇順にソートされる

ヒープソートの視覚化

ヒープソート：1次元配列用のVBAコード


  
    
      Option Explicit



      '============================================================

      ' ヒープソート関数 (メインエントリーポイント)

      '------------------------------------------------------------

      ' 機能：Variant型の1次元配列をヒープソートで並べ替える

      ' 引数：

      '　 sourceArr　　 : ソート対象の配列（1次元配列）。元の配列は変更されない。

      '　 isAscending　 : Trueで昇順、Falseで降順（省略時True）

      '　 compareMode　 : "text"（文字列比較、非区別）、"binary"（文字列比較、区別）、

      '　　　　　　　　　 "value"（数値比較）、"auto"（自動判定）。省略時は "auto"。

      '　 enableDebug　 : Trueにするとイミディエイトウィンドウに詳細ログを出力

      ' 戻り値：

      '　 ソート済み配列（LBound=0）。エラー時はエラー値（#VALUE!）を返す。

      '============================================================

      Public Function HeapSort(ByVal sourceArr As Variant, _

      　　　　　　　　　　　　 Optional ByVal isAscending As Boolean = True, _

      　　　　　　　　　　　　 Optional ByVal compareMode As String = "auto", _

      　　　　　　　　　　　　 Optional ByVal enableDebug As Boolean = False) As Variant

      　　On Error GoTo ErrHandler

      　　

      　　' --- デバッグログの開始 ---

      　　If enableDebug Then

      　　　　Debug.Print String(60, "-")

      　　　　Debug.Print "【HeapSort 開始】"

      　　　　Debug.Print "昇順/降順: "; IIf(isAscending, "昇順", "降順")

      　　　　Debug.Print "compareMode: "; compareMode

      　　End If



      　　' --- 1. 引数検証：配列チェック ---

      　　If Not IsArray(sourceArr) Then

      　　　　Err.Raise vbObjectError + 513, "HeapSort", "引数が配列ではありません。"

      　　End If

      　　

      　　' --- 2. 引数検証：compareModeチェック ---

      　　Dim validMode As String

      　　validMode = LCase(Trim(compareMode)) ' 入力値を小文字・トリミング

      　　If validMode <> "text" And validMode <> "value" And validMode <> "auto" And validMode <> "binary" Then

      　　　　Err.Raise vbObjectError + 514, "HeapSort", _

      　　　　　　　　　"compareModeは 'text'、'value'、'auto'、または 'binary' を指定してください。"

      　　End If



      　　' --- 3. 配列サイズ取得 ---

      　　Dim n As Long ' 配列の要素数

      　　On Error Resume Next

      　　' LBoundとUBoundを使って安全に要素数を計算

      　　n = UBound(sourceArr) - LBound(sourceArr) + 1

      　　If Err.Number <> 0 Then

      　　　　On Error GoTo ErrHandler

      　　　　Err.Raise vbObjectError + 515, "HeapSort", "配列のサイズを取得できません。"

      　　End If

      　　On Error GoTo ErrHandler

      　　

      　　If enableDebug Then Debug.Print "配列要素数: "; n



      　　' --- 4. エッジケース: 要素が1つ以下の場合はソート不要 ---

      　　If n <= 1 Then

      　　　　If enableDebug Then Debug.Print "要素が1つ以下のためソート不要。"

      　　　　HeapSort = sourceArr ' 元の配列をそのまま返す

      　　　　Exit Function

      　　End If

      　　

      　　' --- 5. compareMode が "auto" の場合、最初の要素から判定 ---

      　　If validMode = "auto" Then

      　　　　' 最初の要素が数値であれば"value"（数値比較）を採用

      　　　　If IsNumeric(sourceArr(LBound(sourceArr))) Then

      　　　　　　validMode = "value"

      　　　　Else

      　　　　　　' 数値でなければ"text"（文字列比較、非区別）を採用

      　　　　　　validMode = "text"

      　　　　End If

      　　　　If enableDebug Then Debug.Print "compareMode自動判定結果: "; validMode

      　　End If

      　　

      　　' --- 6. 0ベース配列作成（ヒープソート処理用にLBound=0の配列にコピー） ---

      　　Dim arr() As Variant

      　　ReDim arr(0 To n - 1)

      　　

      　　Dim i As Long

      　　For i = LBound(sourceArr) To UBound(sourceArr)

      　　　　' 元のインデックスとLBoundの差分を使い、0ベースのインデックスに変換してコピー

      　　　　arr(i - LBound(sourceArr)) = sourceArr(i)

      　　Next i



      　　If enableDebug Then Debug.Print "初期配列 (0ベース): "; CustomJoin(arr, ", ")



      　　' --- 7. ヒープソート実行 ---

      　　Call HeapSortCore(arr, isAscending, validMode, enableDebug)



      　　' --- 8. デバッグログの終了 ---

      　　If enableDebug Then

      　　　　Debug.Print "ソート後配列: "; CustomJoin(arr, ", ")

      　　　　Debug.Print "【HeapSort 終了】"

      　　　　Debug.Print String(60, "-")

      　　End If



      　　' ソート済み配列を戻り値として返す

      　　HeapSort = arr

      　　Exit Function



      ErrHandler:

      　　' エラー処理

      　　If enableDebug Then

      　　　　Debug.Print "HeapSort エラー [" & Err.Number & "]: " & Err.Description

      　　End If

      　　' 呼び出し元でチェックできるようエラー値（#VALUE!）を返す

      　　HeapSort = CVErr(xlErrValue)

      End Function



      '------------------------------------------------------------

      ' ヒープソートのコア処理（0ベース配列を前提）

      '------------------------------------------------------------

      Private Sub HeapSortCore(arr() As Variant, _

      　　　　　　　　　　　　 ByVal isAscending As Boolean, _

      　　　　　　　　　　　　 ByVal compareMode As String, _

      　　　　　　　　　　　　 ByVal enableDebug As Boolean)

      　　Dim n As Long

      　　n = UBound(arr) + 1 ' 配列の要素数



      　　Dim i As Long



      　　If enableDebug Then Debug.Print "【ヒープ構築開始】"



      　　' 1. 【ヒープ構築フェーズ】配列をヒープ構造に変換

      　　' 配列の中央付近（親ノードがある最初のインデックス）から逆順に Heapify を適用

      　　For i = (n \ 2) - 1 To 0 Step -1

      　　　　Call Heapify(arr, n, i, isAscending, compareMode, enableDebug)

      　　Next i



      　　If enableDebug Then Debug.Print "【ヒープ構築完了】"



      　　' 2. 【要素抽出/ソートフェーズ】ソート処理

      　　For i = n - 1 To 1 Step -1

      　　　　' 最大/最小要素（ルート: インデックス0）と、未ソート部分の末尾（インデックスi）を交換

      　　　　Call SwapElements(arr, 0, i)

      　　　　If enableDebug Then Debug.Print "Swap: arr(0)<-->arr(" & i & ") → " & CustomJoin(arr, ", ")

      　　　　' 交換した要素を除いた残りの部分 (サイズ i) を再ヒープ化（ルート: 0から開始）

      　　　　Call Heapify(arr, i, 0, isAscending, compareMode, enableDebug)

      　　Next i

      End Sub



      '------------------------------------------------------------

      ' 部分木をヒープの条件を満たすように修正する処理 (再帰処理)

      '------------------------------------------------------------

      Private Sub Heapify(arr() As Variant, _

      　　　　　　　　　　ByVal heapSize As Long, _

      　　　　　　　　　　ByVal rootIdx As Long, _

      　　　　　　　　　　ByVal isAscending As Boolean, _

      　　　　　　　　　　ByVal compareMode As String, _

      　　　　　　　　　　ByVal enableDebug As Boolean)

      　　Dim extremeIdx As Long ' 極値（昇順なら最大、降順なら最小）を持つインデックス

      　　Dim leftIdx As Long　　' 左の子のインデックス (2*i + 1)

      　　Dim rightIdx As Long　 ' 右の子のインデックス (2*i + 2)



      　　extremeIdx = rootIdx

      　　leftIdx = 2 * rootIdx + 1

      　　rightIdx = 2 * rootIdx + 2



      　　' 1. 左の子と現在の極値を比較

      　　If leftIdx < heapSize Then

      　　　　' CompareValuesがTrueを返すとき、左の子の方が極値を持つべき

      　　　　If CompareValues(arr(leftIdx), arr(extremeIdx), isAscending, compareMode) Then

      　　　　　　extremeIdx = leftIdx

      　　　　End If

      　　End If



      　　' 2. 右の子と現在の極値を比較

      　　If rightIdx < heapSize Then

      　　　　' CompareValuesがTrueを返すとき、右の子の方が極値を持つべき

      　　　　If CompareValues(arr(rightIdx), arr(extremeIdx), isAscending, compareMode) Then

      　　　　　　extremeIdx = rightIdx

      　　　　End If

      　　End If



      　　' 3. ルートと子で極値のインデックスが異なるとき（ヒープ条件が崩れている）

      　　If extremeIdx <> rootIdx Then

      　　　　' デバッグログ

      　　　　If enableDebug Then

      　　　　　　Debug.Print "　Heapify: 交換 (" & rootIdx & "," & extremeIdx & _

      　　　　　　　　　　　　") → " & arr(rootIdx) & "<-->" & arr(extremeIdx)

      　　　　End If

      　　　　

      　　　　' ルートと極値を持つ要素を交換

      　　　　Call SwapElements(arr, rootIdx, extremeIdx)

      　　　　' 交換によりヒープ条件が崩れた部分木を、再帰的に修正（再ヒープ化）

      　　　　Call Heapify(arr, heapSize, extremeIdx, isAscending, compareMode, enableDebug)

      　　End If

      End Sub



      '------------------------------------------------------------

      ' 値比較関数（実際の値の大小を判定）

      '------------------------------------------------------------

      Private Function CompareValues(ByVal val1 As Variant, _

      　　　　　　　　　　　　　　　 ByVal val2 As Variant, _

      　　　　　　　　　　　　　　　 ByVal isAscending As Boolean, _

      　　　　　　　　　　　　　　　 ByVal compareMode As String) As Boolean

      　　

      　　Dim result As Integer

      　　Dim num1 As Double, num2 As Double

      　　Dim strCompMode As VbCompareMethod ' 文字列比較モード

      　　

      　　' 文字列比較モードの設定

      　　If compareMode = "text" Then

      　　　　strCompMode = vbTextCompare ' 大文字・小文字を区別しない (非区別)

      　　Else ' compareMode = "binary" の場合

      　　　　strCompMode = vbBinaryCompare ' 大文字・小文字を区別する (区別)

      　　End If



      　　On Error Resume Next ' データ型変換やStrCompでのエラーを一時的に無視



      　　If compareMode = "text" Or compareMode = "binary" Then

      　　　　' 文字列比較（指定された StrCompMode で実行）

      　　　　result = StrComp(CStr(val1), CStr(val2), strCompMode)

      　　Else ' "value" または "auto" からの判定結果 (数値比較ロジック)

      　　　　If IsNumeric(val1) And IsNumeric(val2) Then

      　　　　　　' 厳密な数値比較を行う（CDblでDouble型に変換し、オーバーフローを回避）

      　　　　　　num1 = CDbl(val1)

      　　　　　　num2 = CDbl(val2)

      　　　　　　

      　　　　　　If num1 > num2 Then

      　　　　　　　　result = 1

      　　　　　　ElseIf num1 < num2 Then

      　　　　　　　　result = -1

      　　　　　　Else

      　　　　　　　　result = 0

      　　　　　　End If

      　　　　　　

      　　　　Else

      　　　　　　' 数値でない要素が含まれる場合、安全のため文字列として比較（区別しないTextモードを使用）

      　　　　　　result = StrComp(CStr(val1), CStr(val2), vbTextCompare)

      　　　　End If

      　　End If

      　　

      　　On Error GoTo 0 ' エラー処理を復帰



      　　' 最終的な比較結果の判定

      　　If isAscending Then

      　　　　' 昇順: val1 > val2 の時、Trueを返す（最大ヒープを構築し、大きい方をルートに持ってくる）

      　　　　CompareValues = (result > 0)

      　　Else

      　　　　' 降順: val1 < val2 の時、Trueを返す（最小ヒープを構築し、小さい方をルートに持ってくる）

      　　　　CompareValues = (result < 0)

      　　End If

      End Function



      '------------------------------------------------------------

      ' 配列の2つの要素を交換する (1次元配列専用)

      '------------------------------------------------------------

      Private Sub SwapElements(arr() As Variant, ByVal idx1 As Long, ByVal idx2 As Long)

      　　Dim temp As Variant

      　　temp = arr(idx1)

      　　arr(idx1) = arr(idx2)

      　　arr(idx2) = temp

      End Sub

VBAの解説

このコードは、1次元の Variant 型配列をヒープソートで効率よく並べ替えるためのものです。

1. Public Function HeapSort（メイン関数）

	説明
役割	ユーザーインターフェース。配列とソート条件（昇順/降順、比較モードなど）を受け取り、ソート全体の流れを制御します。
主な処理	1. 引数チェック（配列か、モードが正しいか）とエラー処理。 2. 要素数を取得し、ソート不要なケース（要素数1以下）を処理。 3. compareMode="auto"の場合、最初の要素から比較モードを自動判定。 4. 0ベース配列にコピー（ヒープソートの処理は0ベース前提）。 5. HeapSortCoreを呼び出し、ソートを実行。 6. ソート結果の配列を戻り値として返します。

2. Private Sub HeapSortCore（ソートの実行核）

	説明
役割	ヒープソートアルゴリズムの2つの主要ステップ（ヒープ構築と要素抽出）を実行します。
主な処理	1. 【ヒープ構築】 Heapifyを繰り返し呼び出し、配列全体をヒープ構造に変換します。 2. 【ソート実行】配列のルート（最大/最小要素）と末尾要素をSwapElementsで交換し、未ソート部分をHeapifyで再修正することを繰り返します。

3. Private Sub Heapify（ヒープ構造の維持）

	説明
役割	特定のノードをルートとする部分木に対し、ヒープ条件を強制的に満たさせる（再ヒープ化する）再帰的な処理です。
主な処理	1. ルートノードと、その子ノード（左、右）のインデックスを計算。 2. CompareValuesを使って、ルート、左の子、右の子の中で極値（昇順なら最大、降順なら最小）を持つノードを特定。 3. 極値がルートでなければ、SwapElementsで要素を交換し、再帰的にHeapifyを呼び出して下位の部分木も修正します。

4. Private Function CompareValues（値比較ロジック）

	説明
役割	2つの値（val1, val2）を受け取り、指定された比較モード（text, binary, value）に基づいて大小関係を判定します。
主な処理	1. "value"モード: CDblを使って数値を比較し、オーバーフローを回避します。 2. "text"/"binary"モード: StrCompを使って文字列を比較（"binary"で大文字小文字を区別）。 3. 昇順/降順の指定に基づき、交換が必要か（True）を判定して返します。
特徴	1次元配列のため、2次元配列のようなキー列の抽出処理は不要です。

5. Private Sub SwapElements（要素の交換）

	説明
役割	1次元配列内の指定された2つのインデックスの要素を入れ替えます。
主な処理	一時変数（temp）を使って、arr(idx1)とarr(idx2)の値を交換します。

ヒープソート：1次元配列用の実行テスト


  
    
      '============================================================

' HeapSort テストスイート (メイン実行プロシージャ)

      '============================================================

Sub RunAllHeapSortTests()

      　　Debug.Print String(60, "=")

　　Debug.Print "HEAP SORT TEST SUITE - START"

      　　Debug.Print String(60, "=")

　　

　　' 各テストケースを順番に実行

　　Test_BasicNumericSorts

　　Test_BasicStringSorts

　　Test_BinaryStringSorts ' 大文字・小文字区別ソートのテスト

　　Test_CompareModes

　　Test_EdgeCases

　　Test_NonZeroLBound

　　Test_ErrorHandling

　　Test_DebugMode

　　

      　　Debug.Print String(60, "=")

　　Debug.Print "HEAP SORT TEST SUITE - COMPLETE"

      　　Debug.Print String(60, "=")

End Sub



' --- テストケース群 ---



Private Sub Test_BasicNumericSorts()

　　Debug.Print vbCrLf & "--- 1. 基本的な数値ソート ---"

　　Dim testArr As Variant

　　testArr = Array(64, 34, -25, 12, 22, 11, 90, 0)

　　

　　' 1-1. 数値 (昇順) ソート（compareMode="value"を明示）

　　Dim expectedAsc As Variant

　　expectedAsc = Array(-25, 0, 11, 12, 22, 34, 64, 90)

　　AssertEqual "1-1. 数値 (昇順)", testArr, HeapSort(testArr, True, "value"), expectedAsc

　　

　　' 1-2. 数値 (降順) ソート

　　Dim expectedDesc As Variant

　　expectedDesc = Array(90, 64, 34, 22, 12, 11, 0, -25)

　　AssertEqual "1-2. 数値 (降順)", testArr, HeapSort(testArr, False, "value"), expectedDesc

End Sub



Private Sub Test_BasicStringSorts()

　　Debug.Print vbCrLf & "--- 2. 基本的な文字列ソート (Textモード/非区別) ---"

　　Dim testArr As Variant

　　testArr = Array("banana", "apple", "orange", "grape", "cherry")

　　

　　' 2-1. 文字列 (Text昇順) ソート

　　Dim expectedAsc As Variant

　　expectedAsc = Array("apple", "banana", "cherry", "grape", "orange")

　　AssertEqual "2-1. 文字列 (Text昇順)", testArr, HeapSort(testArr, True, "text"), expectedAsc

　　

　　' 2-2. 文字列 (Text降順) ソート

　　Dim expectedDesc As Variant

　　expectedDesc = Array("orange", "grape", "cherry", "banana", "apple")

　　AssertEqual "2-2. 文字列 (Text降順)", testArr, HeapSort(testArr, False, "text"), expectedDesc

End Sub



' --- 3. 文字列ソート (Binaryモード/区別) ---

Private Sub Test_BinaryStringSorts()

　　Debug.Print vbCrLf & "--- 3. 文字列ソート (Binaryモード/区別) ---"

　　Dim testArr As Variant

　　testArr = Array("Apple", "apple", "Banana", "banana", "Cherry") ' 大文字と小文字が混在

　　

　　' 3-1. 昇順: 文字コード順 (大文字A,B,... < 小文字a,b,...) を検証

　　Dim expectedAsc As Variant

　　expectedAsc = Array("Apple", "Banana", "Cherry", "apple", "banana")

　　AssertEqual "3-1. 文字列 (Binary昇順)", testArr, HeapSort(testArr, True, "binary"), expectedAsc

　　

　　' 3-2. 降順: 文字コード順 (小文字 > 大文字) を検証

　　Dim expectedDesc As Variant

　　expectedDesc = Array("banana", "apple", "Cherry", "Banana", "Apple")

　　AssertEqual "3-2. 文字列 (Binary降順)", testArr, HeapSort(testArr, False, "binary"), expectedDesc

End Sub



Private Sub Test_CompareModes()

　　Debug.Print vbCrLf & "--- 4. 比較モードのテスト ---"

　　Dim testArr As Variant

　　testArr = Array("10", 2, "1", 100, "25") ' 数値と文字列が混在



　　' 4-1. autoモード: 最初の要素が文字列"10"のため、"text"モードに自動判定されるべき

　　Dim expectedAuto As Variant

　　expectedAuto = Array("1", "10", 100, 2, "25") ' 文字コード順 ("1" < "10" < "100"...)

　　' ★注意：最初の要素がIsNumeric("10")=Trueであるため、"value"と判定されます。（修正済みロジックに基づく）

　　expectedAuto = Array("1", 2, "10", "25", 100)

　　AssertEqual "4-1. 混在データ (auto)", testArr, HeapSort(testArr), expectedAuto



　　' 4-2. valueモード: 全て数値として比較

　　Dim expectedValue As Variant

　　expectedValue = Array("1", 2, "10", "25", 100)

　　AssertEqual "4-2. 混在データ (value)", testArr, HeapSort(testArr, True, "value"), expectedValue

　　

　　' 4-3. textモード: 全て文字列として比較（文字コード順）

　　Dim expectedText As Variant

　　expectedText = Array("1", "10", 100, 2, "25")

　　AssertEqual "4-3. 混在データ (text)", testArr, HeapSort(testArr, True, "text"), expectedText

End Sub



Private Sub Test_EdgeCases()

　　Debug.Print vbCrLf & "--- 5. エッジケースのテスト ---"

　　Dim testArr As Variant, resultArr As Variant, expectedArr As Variant



　　' 5-1. 空の配列: 要素数0の処理を検証

　　testArr = Array()

　　expectedArr = Array()

　　AssertEqual "5-1. 空の配列", testArr, HeapSort(testArr), expectedArr

　　

　　' 5-2. 要素が1つ: ソート不要の処理を検証

　　testArr = Array(100)

　　expectedArr = Array(100)

　　AssertEqual "5-2. 要素が1つの配列", testArr, HeapSort(testArr), expectedArr



　　' 5-3. 重複する値: 安定性の確認（ヒープソートは不安定）

　　testArr = Array(5, 2, 8, 2, 5, 1)

　　expectedArr = Array(1, 2, 2, 5, 5, 8)

　　AssertEqual "5-3. 重複する値を含む配列", testArr, HeapSort(testArr), expectedArr

　　

　　' 5-4. 既に昇順ソート済み: 既にソートされた配列の処理効率を検証

　　testArr = Array(10, 20, 30, 40, 50)

　　expectedArr = Array(10, 20, 30, 40, 50)

　　AssertEqual "5-4. 既に昇順ソート済みの配列", testArr, HeapSort(testArr), expectedArr



　　' 5-5. 既に降順ソート済み: 逆順の配列を昇順にソートする処理を検証

　　testArr = Array(50, 40, 30, 20, 10)

　　expectedArr = Array(10, 20, 30, 40, 50)

　　AssertEqual "5-5. 既に降順ソート済みの配列 (昇順へ)", testArr, HeapSort(testArr), expectedArr

End Sub



Private Sub Test_NonZeroLBound()

　　Debug.Print vbCrLf & "--- 6. 0以外のLBoundを持つ配列 ---"

　　Dim testArr(5 To 10) As Long ' LBound=5の配列を定義

　　testArr(5) = 99: testArr(6) = 15: testArr(7) = 42

　　testArr(8) = 7: testArr(9) = 88: testArr(10) = 30



　　' 6-1. LBoundが5の配列: HeapSortはLBound=0の配列を返却する想定

　　Dim expectedArr As Variant

　　expectedArr = Array(7, 15, 30, 42, 88, 99)

　　AssertEqual "6-1. LBoundが5の配列", testArr, HeapSort(testArr), expectedArr

End Sub



Private Sub Test_ErrorHandling()

　　Debug.Print vbCrLf & "--- 7. エラーハンドリング ---"

　　Dim result As Variant

　　

　　' 7-1. 非配列を渡す: IsArrayチェックを検証

　　result = HeapSort("not an array")

　　If IsError(result) And result = CVErr(xlErrValue) Then

　　　　Debug.Print "7-1. 非配列の引数　　　: PASS - 正常にエラー値を返しました。"

　　Else

　　　　Debug.Print "7-1. 非配列の引数　　　: FAIL - エラーを検知できませんでした。"

　　End If

　　

　　' 7-2. 不正なcompareModeを渡す: 引数検証を検証

　　result = HeapSort(Array(1, 2), True, "invalid_mode")

　　If IsError(result) And result = CVErr(xlErrValue) Then

　　　　Debug.Print "7-2. 不正なcompareMode　　　: PASS - 正常にエラー値を返しました。"

　　Else

　　　　Debug.Print "7-2. 不正なcompareMode　　　: FAIL - エラーを検知できませんでした。"

　　End If

End Sub



Private Sub Test_DebugMode()

　　Debug.Print vbCrLf & "--- 8. デバッグモードのテスト ---"

　　Debug.Print "↓ enableDebug=True を実行します。詳細ログがイミディエイトに出力されれば PASS です。"

　　Dim testArr As Variant

　　testArr = Array(3, 1, 2)

　　' 実行することでログ出力の有無を確認

　　Call HeapSort(testArr, True, "auto", True)

　　Debug.Print "↑ enableDebug=True の実行が完了しました。"

End Sub





' --- テスト結果を比較・表示するためのヘルパー ---

Private Sub AssertEqual(ByVal testName As String, _

　　　　　　　　　　　　ByVal originalArr As Variant, _

　　　　　　　　　　　　ByVal actualResult As Variant, _

　　　　　　　　　　　　ByVal expectedResult As Variant)



　　' テスト名の出力

　　Debug.Print testName

　　

　　' 元の配列の文字列化

　　Dim originalArrStr As String

　　If IsArray(originalArr) Then

　　　　If UBound(originalArr) >= LBound(originalArr) Then

　　　　　　originalArrStr = CustomJoin(originalArr, ", ")

　　　　Else

　　　　　　originalArrStr = "(Empty Array)"

　　　　End If

　　Else

　　　　originalArrStr = "N/A"

　　End If

　　

　　Debug.Print "　- 元の配列:　　" & originalArrStr



　　' エラー値チェック

　　If IsError(actualResult) Then

　　　　Debug.Print "　- 実行結果:　　エラー値 (" & CStr(actualResult) & ")"

　　　　Debug.Print "　- 期待結果:　　" & CustomJoin(expectedResult, ", ")

　　　　Debug.Print "　- 結果:　　　　FAIL ★★★"

　　　　Exit Sub

　　End If

　　

　　' 結果の文字列化と比較

　　Dim actualStr As String, expectedStr As String

　　actualStr = CustomJoin(actualResult, ", ")

　　expectedStr = CustomJoin(expectedResult, ", ")

　　

　　If actualStr = expectedStr Then

　　　　Debug.Print "　- 実行結果:　　" & actualStr

　　　　Debug.Print "　- 結果:　　　　PASS"

　　Else

　　　　Debug.Print "　- 実行結果:　　" & actualStr

　　　　Debug.Print "　- 期待結果:　　" & expectedStr

　　　　Debug.Print "　- 結果:　　　　FAIL ★★★"

　　End If

End Sub



      '------------------------------------------------------------

' CustomJoin関数 (Join関数のエラー回避用)

      '------------------------------------------------------------

' 配列の要素を文字列に変換し、安全に結合する。

Private Function CustomJoin(arr As Variant, delimiter As String) As String

　　Dim i As Long

　　Dim tempArr() As String

　　

　　If Not IsArray(arr) Then

　　　　CustomJoin = ""

　　　　Exit Function

　　End If

　　

　　' 要素数0の場合

　　On Error Resume Next

　　If UBound(arr) < LBound(arr) Then

　　　　CustomJoin = ""

　　　　On Error GoTo 0

　　　　Exit Function

　　End If

　　On Error GoTo 0

　　

　　ReDim tempArr(LBound(arr) To UBound(arr))

　　For i = LBound(arr) To UBound(arr)

　　　　' 要素を強制的に文字列に変換し、エラー値などを回避

　　　　On Error Resume Next

　　　　tempArr(i) = CStr(arr(i))

　　　　On Error GoTo 0

　　Next i

　　

　　CustomJoin = Join(tempArr, delimiter)

End Function

VBAコードの解説

プロシージャ名	役割	テスト内容
RunAllHeapSortTests	全体実行	すべてのテストプロシージャを順次実行するメインのテストランナーです。
Test_BasicNumericSorts	数値基本	正負の数を含む配列に対し、昇順・降順ソートの正確性を検証します。
Test_BasicStringSorts	文字列 (Text)	大文字・小文字を区別しないソート ("text") を検証します。
Test_BinaryStringSorts	文字列 (Binary)	大文字・小文字を区別するソート ("binary") が正しく行われるかを検証します。
Test_CompareModes	モード混在	数値と文字列が混在したデータに対して、"auto", "value", "text" の各モードが期待通りに動作するかを検証します。
Test_EdgeCases	境界条件	空の配列、単一要素、重複値、既にソート済みの配列など、特殊なケースでの動作を検証します。
Test_NonZeroLBound	非ゼロLBound	LBoundが0以外の配列を渡した際、0ベースで正しくソート結果が返るかを検証します。
Test_ErrorHandling	エラー処理	非配列の引数や不正な比較モードを渡した際に、エラー値（#VALUE!）を返すかを検証します。
Test_DebugMode	デバッグ確認	enableDebug=Trueオプションを付けた際に、イミディエイトウィンドウに詳細なログが出力されるかを検証します。
AssertEqual	結果比較	実行結果と期待結果を比較し、PASS/FAILを判定してログに出力する共通ヘルパー関数です。

テストコードの実行結果

============================================================
HEAP SORT TEST SUITE - START
============================================================

--- 1. 基本的な数値ソート ---
1-1. 数値 (昇順)
  - 元の配列:    64, 34, -25, 12, 22, 11, 90, 0
  - 実行結果:    -25, 0, 11, 12, 22, 34, 64, 90
  - 結果:        PASS
1-2. 数値 (降順)
  - 元の配列:    64, 34, -25, 12, 22, 11, 90, 0
  - 実行結果:    90, 64, 34, 22, 12, 11, 0, -25
  - 結果:        PASS

--- 2. 基本的な文字列ソート (Textモード/非区別) ---
2-1. 文字列 (Text昇順)
  - 元の配列:    banana, apple, orange, grape, cherry
  - 実行結果:    apple, banana, cherry, grape, orange
  - 結果:        PASS
2-2. 文字列 (Text降順)
  - 元の配列:    banana, apple, orange, grape, cherry
  - 実行結果:    orange, grape, cherry, banana, apple
  - 結果:        PASS

--- 3. 文字列ソート (Binaryモード/区別) ---
3-1. 文字列 (Binary昇順)
  - 元の配列:    Apple, apple, Banana, banana, Cherry
  - 実行結果:    Apple, Banana, Cherry, apple, banana
  - 結果:        PASS
3-2. 文字列 (Binary降順)
  - 元の配列:    Apple, apple, Banana, banana, Cherry
  - 実行結果:    banana, apple, Cherry, Banana, Apple
  - 結果:        PASS

--- 4. 比較モードのテスト ---
4-1. 混在データ (auto)
  - 元の配列:    10, 2, 1, 100, 25
  - 実行結果:    1, 2, 10, 25, 100
  - 結果:        PASS
4-2. 混在データ (value)
  - 元の配列:    10, 2, 1, 100, 25
  - 実行結果:    1, 2, 10, 25, 100
  - 結果:        PASS
4-3. 混在データ (text)
  - 元の配列:    10, 2, 1, 100, 25
  - 実行結果:    1, 10, 100, 2, 25
  - 結果:        PASS

--- 5. エッジケースのテスト ---
5-1. 空の配列
  - 元の配列:    (Empty Array)
  - 実行結果:    
  - 結果:        PASS
5-2. 要素が1つの配列
  - 元の配列:    100
  - 実行結果:    100
  - 結果:        PASS
5-3. 重複する値を含む配列
  - 元の配列:    5, 2, 8, 2, 5, 1
  - 実行結果:    1, 2, 2, 5, 5, 8
  - 結果:        PASS
5-4. 既に昇順ソート済みの配列
  - 元の配列:    10, 20, 30, 40, 50
  - 実行結果:    10, 20, 30, 40, 50
  - 結果:        PASS
5-5. 既に降順ソート済みの配列 (昇順へ)
  - 元の配列:    50, 40, 30, 20, 10
  - 実行結果:    10, 20, 30, 40, 50
  - 結果:        PASS

--- 6. 0以外のLBoundを持つ配列 ---
6-1. LBoundが5の配列
  - 元の配列:    99, 15, 42, 7, 88, 30
  - 実行結果:    7, 15, 30, 42, 88, 99
  - 結果:        PASS

--- 7. エラーハンドリング ---
7-1. 非配列の引数      : PASS - 正常にエラー値を返しました。
7-2. 不正なcompareMode      : PASS - 正常にエラー値を返しました。

--- 8. デバッグモードのテスト ---
↓ enableDebug=True を実行します。詳細ログがイミディエイトに出力されれば PASS です。
------------------------------------------------------------
【HeapSort 開始】
昇順/降順: 昇順
compareMode: auto
配列要素数:  3 
compareMode自動判定結果: value
初期配列 (0ベース): 3, 1, 2
【ヒープ構築開始】
【ヒープ構築完了】
Swap: arr(0)<-->arr(2) → 2, 1, 3
Swap: arr(0)<-->arr(1) → 1, 2, 3
ソート後配列: 1, 2, 3
【HeapSort 終了】
------------------------------------------------------------
↑ enableDebug=True の実行が完了しました。
============================================================
HEAP SORT TEST SUITE - COMPLETE
============================================================

すべてのテストケースが期待通りに動作しました。

ヒープソート：1次元/2次元配列対応版のVBAコード


  
    
      Option Explicit



      '============================================================

      ' ヒープソート関数 (1次元/2次元配列対応版)

      '------------------------------------------------------------

      ' 機能：Variant型の1次元配列、または2次元配列をヒープソートで並べ替える

' 引数：

'　 sourceArr　　 : ソート対象の配列（1次元または2次元配列）

'　 keyColumn　　 : 2次元配列の場合、ソートのキーとなる列のインデックスを指定 (1次元配列の場合は無視される)

'　　　　　　　　　 （省略時 1: 1列目を使用）

'　 isAscending　 : Trueで昇順、Falseで降順（省略時True）

'　 compareMode　 : "text"（文字列比較、大文字小文字を区別しない）

'　　　　　　　　　 "binary"（文字列比較、大文字小文字を区別する）

'　　　　　　　　　 "value"（数値比較）

'　　　　　　　　　 "auto"（自動判定）

'　　　　　　　　　 省略時は "auto"

'　 enableDebug　 : Trueにするとイミディエイトウィンドウに詳細ログを出力

' 戻り値：

'　 ソート済み配列（元配列は変更されない）

'　 エラー時はエラー値（#VALUE!）を返す

      '============================================================

Public Function HeapSort(ByVal sourceArr As Variant, _

　　　　　　　　　　　　 Optional ByVal keyColumn As Long = 1, _

　　　　　　　　　　　　 Optional ByVal isAscending As Boolean = True, _

　　　　　　　　　　　　 Optional ByVal compareMode As String = "auto", _

　　　　　　　　　　　　 Optional ByVal enableDebug As Boolean = False) As Variant

　　On Error GoTo ErrHandler

　　

　　' デバッグモードが有効な場合、ソート条件をイミディエイトに出力

　　If enableDebug Then

　　　　Debug.Print String(60, "-")

　　　　Debug.Print "【HeapSort 開始】"

　　　　Debug.Print "昇順/降順: "; IIf(isAscending, "昇順", "降順")

　　　　Debug.Print "compareMode: "; compareMode

　　　　' 2次元配列の場合のみキー列を出力

　　　　If IsArray(sourceArr) And GetArrayDimensions(sourceArr) = 2 Then

　　　　　　Debug.Print "キー列: "; keyColumn

　　　　End If

　　End If



　　' --- 引数検証：配列チェック ---

　　If Not IsArray(sourceArr) Then

　　　　Err.Raise vbObjectError + 513, "HeapSort", "引数が配列ではありません。"

　　End If



　　' --- 配列情報取得 ---

　　Dim arrDim As Long　　　　　　 ' 配列の次元数 (1 or 2)

　　Dim n As Long　　　　　　　　　' 要素数 (行数)

　　Dim lBound1 As Long, uBound1 As Long

　　Dim lBound2 As Long, uBound2 As Long ' 2次元配列の場合の列の範囲

　　Dim i As Long, j As Long　　　 ' ループ用変数



　　' 配列の次元数を取得

　　arrDim = GetArrayDimensions(sourceArr)

　　If arrDim = 0 Then Err.Raise vbObjectError + 515, "HeapSort", "配列のサイズを取得できません。"



　　' 1次元目の範囲（行数）を取得

　　lBound1 = LBound(sourceArr, 1)

　　uBound1 = UBound(sourceArr, 1)

　　n = uBound1 - lBound1 + 1 ' 要素数（行数）



　　If arrDim = 2 Then

　　　　' 2次元配列の場合、2次元目（列）の範囲を取得

　　　　lBound2 = LBound(sourceArr, 2)

　　　　uBound2 = UBound(sourceArr, 2)

　　　　

　　　　' キー列のインデックスが範囲内かチェック

　　　　If keyColumn < lBound2 Or keyColumn > uBound2 Then

　　　　　　Err.Raise vbObjectError + 516, "HeapSort", "keyColumnが配列の列の範囲外です (" & lBound2 & "～" & uBound2 & ")."

　　　　End If

　　End If

　　

　　' --- 引数検証：compareModeチェック ---

　　Dim validMode As String

　　validMode = LCase(Trim(compareMode)) ' 小文字に変換してトリミング

　　If validMode <> "text" And validMode <> "value" And validMode <> "auto" And validMode <> "binary" Then

　　　　Err.Raise vbObjectError + 514, "HeapSort", _

　　　　　　　　　"compareModeは 'text'、'value'、'auto'、または 'binary' を指定してください。"

　　End If



　　If enableDebug Then Debug.Print "配列要素数 (行数): "; n



　　' --- 要素が1つ以下の場合はソート不要 ---

　　If n <= 1 Then

　　　　If enableDebug Then Debug.Print "要素が1つ以下のためソート不要。"

　　　　HeapSort = sourceArr

　　　　Exit Function

　　End If



　　' --- compareMode が "auto" の場合、最初の要素から判定 ---

　　Dim compareVal As Variant

　　' 最初の要素（キー列）の値を取得

　　If arrDim = 1 Then

　　　　compareVal = sourceArr(lBound1)

　　Else ' 2次元の場合

　　　　compareVal = sourceArr(lBound1, keyColumn)

　　End If



　　If validMode = "auto" Then

　　　　' 最初の要素が数値であれば"value"、そうでなければ"text"を採用

　　　　If IsNumeric(compareVal) Then

　　　　　　validMode = "value"

　　　　Else

　　　　　　validMode = "text"

　　　　End If

　　　　If enableDebug Then Debug.Print "compareMode自動判定結果: "; validMode

　　End If

　　

　　' --- 0ベース配列作成（arrDimを保持） ---

　　' ヒープソートの計算ロジック（Heapify）は0ベースを前提とするため、ここでコピーを行う

　　Dim arr As Variant

　　

　　If arrDim = 1 Then

　　　　' 1次元配列を0ベースにコピー

　　　　ReDim arr(0 To n - 1)

　　　　For i = lBound1 To uBound1

　　　　　　arr(i - lBound1) = sourceArr(i)

　　　　Next i

　　Else ' 2次元配列の場合 (列の範囲は維持して0ベースにコピー)

　　　　ReDim arr(0 To n - 1, lBound2 To uBound2)

　　　　For i = lBound1 To uBound1

　　　　　　For j = lBound2 To uBound2

　　　　　　　　arr(i - lBound1, j) = sourceArr(i, j)

　　　　　　Next j

　　　　Next i

　　End If



　　' --- ヒープソート実行 ---

　　' 0ベースに変換された配列と各種設定をコア処理に渡す

　　Call HeapSortCore(arr, isAscending, validMode, keyColumn, arrDim)



　　If enableDebug Then

　　　　Debug.Print "【HeapSort 終了】"

　　　　Debug.Print String(60, "-")

　　End If



　　' 結果を戻り値としてセット

　　HeapSort = arr

　　Exit Function



ErrHandler:

　　' エラーが発生した場合、デバッグログに出力

　　If enableDebug Then

　　　　Debug.Print "HeapSort エラー [" & Err.Number & "]: " & Err.Description

　　End If

　　' エラー値を戻り値として返す

　　HeapSort = CVErr(xlErrValue)

End Function



      '------------------------------------------------------------

' ヒープソートのコア処理（0ベース配列を前提）

      '------------------------------------------------------------

Private Sub HeapSortCore(arr As Variant, _

　　　　　　　　　　　　 ByVal isAscending As Boolean, _

　　　　　　　　　　　　 ByVal compareMode As String, _

　　　　　　　　　　　　 ByVal keyColumn As Long, _

　　　　　　　　　　　　 ByVal arrDim As Long)

　　Dim n As Long

　　' 常に1次元目(行)のサイズを取得 (0ベースなので +1)

　　n = UBound(arr, 1) + 1



　　Dim i As Long



　　' 1. 配列をヒープ構造に変換（最大/最小ヒープを構築）

　　' n/2 - 1 から 0 まで逆順に Heapify を適用

　　For i = (n \ 2) - 1 To 0 Step -1

　　　　Call Heapify(arr, n, i, isAscending, compareMode, keyColumn, arrDim)

　　Next i



　　' 2. ソート処理（ヒープから要素を取り出す）

　　' 末尾から先頭までループ

　　For i = n - 1 To 1 Step -1

　　　　' 最大/最小要素（ルート: インデックス0）と末尾の要素を交換

　　　　Call SwapElements(arr, 0, i, arrDim)

　　　　' 交換した要素を除いた残りの部分 (サイズ i) を再ヒープ化

　　　　Call Heapify(arr, i, 0, isAscending, compareMode, keyColumn, arrDim)

　　Next i

End Sub



      '------------------------------------------------------------

' 部分木をヒープの条件を満たすように修正する処理 (ヒープ操作の核)

      '------------------------------------------------------------

Private Sub Heapify(arr As Variant, _

　　　　　　　　　　ByVal heapSize As Long, _

　　　　　　　　　　ByVal rootIdx As Long, _

　　　　　　　　　　ByVal isAscending As Boolean, _

　　　　　　　　　　ByVal compareMode As String, _

　　　　　　　　　　ByVal keyColumn As Long, _

　　　　　　　　　　ByVal arrDim As Long)

　　Dim extremeIdx As Long ' 極値（最大または最小）を持つインデックス

　　Dim leftIdx As Long　　' 左の子のインデックス

　　Dim rightIdx As Long　 ' 右の子のインデックス



　　extremeIdx = rootIdx

　　leftIdx = 2 * rootIdx + 1

　　rightIdx = 2 * rootIdx + 2



　　' 左の子がヒープサイズ内かチェック

　　If leftIdx < heapSize Then

　　　　' 左の子と現在の極値（ルート）を比較し、ヒープ条件に反していれば極値を更新

　　　　If CompareElements(arr, leftIdx, extremeIdx, isAscending, compareMode, keyColumn, arrDim) Then

　　　　　　extremeIdx = leftIdx

　　　　End If

　　End If



　　' 右の子がヒープサイズ内かチェック

　　If rightIdx < heapSize Then

　　　　' 右の子と現在の極値を比較し、ヒープ条件に反していれば極値を更新

　　　　If CompareElements(arr, rightIdx, extremeIdx, isAscending, compareMode, keyColumn, arrDim) Then

　　　　　　extremeIdx = rightIdx

　　　　End If

　　End If



　　' 極値を持つインデックスがルートと異なる場合（ヒープ条件に反していた場合）

　　If extremeIdx <> rootIdx Then

　　　　' ルートと極値を持つ要素を交換

　　　　Call SwapElements(arr, rootIdx, extremeIdx, arrDim)

　　　　' 交換によりヒープ条件が崩れた部分木を、再帰的に修正（再ヒープ化）

　　　　Call Heapify(arr, heapSize, extremeIdx, isAscending, compareMode, keyColumn, arrDim)

　　End If

End Sub



      '------------------------------------------------------------

' 要素比較関数 (Heapifyから呼び出される - 1D/2Dのキー列抽出を担当)

      '------------------------------------------------------------

Private Function CompareElements(arr As Variant, _

　　　　　　　　　　　　　　　　 ByVal idx1 As Long, _

　　　　　　　　　　　　　　　　 ByVal idx2 As Long, _

　　　　　　　　　　　　　　　　 ByVal isAscending As Boolean, _

　　　　　　　　　　　　　　　　 ByVal compareMode As String, _

　　　　　　　　　　　　　　　　 ByVal keyColumn As Long, _

　　　　　　　　　　　　　　　　 ByVal arrDim As Long) As Boolean

　　

　　Dim val1 As Variant, val2 As Variant

　　

　　' 1次元/2次元に応じて比較対象の「値」を取得

　　If arrDim = 1 Then

　　　　' 1次元配列の場合、要素そのものを取得

　　　　val1 = arr(idx1)

　　　　val2 = arr(idx2)

　　Else ' 2次元の場合

　　　　' 2次元配列の場合、指定されたキー列の値を取得

　　　　val1 = arr(idx1, keyColumn)

　　　　val2 = arr(idx2, keyColumn)

　　End If



　　' 抽出した値を CompareValues に渡し、比較結果を取得

　　CompareElements = CompareValues(val1, val2, isAscending, compareMode)

End Function



      '------------------------------------------------------------

' 値比較関数（オーバーフロー回避済み - 実際の値の比較ロジック）

      '------------------------------------------------------------

Private Function CompareValues(ByVal val1 As Variant, _

　　　　　　　　　　　　　　　 ByVal val2 As Variant, _

　　　　　　　　　　　　　　　 ByVal isAscending As Boolean, _

　　　　　　　　　　　　　　　 ByVal compareMode As String) As Boolean

　　

　　Dim result As Integer

　　Dim num1 As Double

　　Dim num2 As Double

　　Dim strCompMode As VbCompareMethod

　　

　　' 比較モードに応じて文字列比較のオプションを設定

　　If compareMode = "text" Then

　　　　strCompMode = vbTextCompare ' 大文字小文字を区別しない

　　Else ' compareMode = "binary" の場合

　　　　strCompMode = vbBinaryCompare ' 大文字小文字を区別する

　　End If



　　On Error Resume Next

　　

　　If compareMode = "text" Or compareMode = "binary" Then

　　　　' 文字列比較

　　　　result = StrComp(CStr(val1), CStr(val2), strCompMode)

　　Else ' "value" または "auto" からの判定結果

　　　　If IsNumeric(val1) And IsNumeric(val2) Then

　　　　　　' 数値比較 (CDblでオーバーフローを回避)

　　　　　　num1 = CDbl(val1)

　　　　　　num2 = CDbl(val2)

　　　　　　If num1 > num2 Then

　　　　　　　　result = 1

　　　　　　ElseIf num1 < num2 Then

　　　　　　　　result = -1

　　　　　　Else

　　　　　　　　result = 0

　　　　　　End If

　　　　Else

　　　　　　' 数値と非数値が混在した場合（テキスト比較にフォールバック）

　　　　　　result = StrComp(CStr(val1), CStr(val2), vbTextCompare)

　　　　End If

　　End If

　　

　　On Error GoTo 0



　　' 昇順/降順の判定

　　If isAscending Then

　　　　' 昇順: result > 0 のとき（val1 > val2）に True (交換が必要)

　　　　CompareValues = (result > 0)

　　Else

　　　　' 降順: result < 0 のとき（val1 < val2）に True (交換が必要)

　　　　CompareValues = (result < 0)

　　End If

End Function



      '------------------------------------------------------------

' 配列の2つの要素（行全体）を交換する

      '------------------------------------------------------------

Private Sub SwapElements(arr As Variant, ByVal idx1 As Long, ByVal idx2 As Long, ByVal arrDim As Long)

　　Dim temp As Variant

　　

　　If arrDim = 1 Then

　　　　' 1次元配列の場合、要素を交換

　　　　temp = arr(idx1)

　　　　arr(idx1) = arr(idx2)

　　　　arr(idx2) = temp

　　Else ' 2次元配列の場合、行全体を交換

　　　　Dim j As Long

　　　　Dim lBound2 As Long, uBound2 As Long

　　　　

　　　　lBound2 = LBound(arr, 2)

　　　　uBound2 = UBound(arr, 2)

　　　　

　　　　' 2次元目のすべての列をループして要素を交換

　　　　For j = lBound2 To uBound2

　　　　　　temp = arr(idx1, j)

　　　　　　arr(idx1, j) = arr(idx2, j)

　　　　　　arr(idx2, j) = temp

　　　　Next j

　　End If

End Sub



      '------------------------------------------------------------

' 配列の次元数を取得するヘルパー関数 (1D/2D判定に使用)

      '------------------------------------------------------------

Private Function GetArrayDimensions(ByVal arr As Variant) As Long

　　Dim dimCount As Long

　　Dim dummy As Long ' LBound関数の戻り値を格納するためのダミー変数（文法エラー回避）

　　

　　On Error Resume Next

　　dimCount = 1

　　Do While True

　　　　' 指定次元のLBoundを取得してみて、エラーが発生するかで次元を判定

　　　　dummy = LBound(arr, dimCount)

　　　　

　　　　If Err.Number <> 0 Then

　　　　　　Exit Do ' エラーが発生したらその次元は存在しない

　　　　End If

　　　　dimCount = dimCount + 1

　　Loop

　　On Error GoTo 0

　　' 最後にインクリメントされた分を引いて、正しい次元数を返す

　　GetArrayDimensions = dimCount - 1

      End Function

VBAの解説

このコードは、ヒープソートというアルゴリズムを使って、1次元または2次元の配列を効率よく並べ替えるためのものです。

1. Public Function HeapSort（メイン関数）

この関数は、ソート処理全体の玄関口となるメインの関数です。

	説明
役割	ユーザーから配列とソート条件（昇順/降順、キー列、比較モードなど）を受け取り、ソート処理全体を統括します。
主な処理	1. 引数のチェックとエラー処理を行います。 2. GetArrayDimensionsで配列の次元（1次元か2次元か）を判定します。 3. 渡された配列をソートしやすい0ベースの配列（arr）にコピーします。 4. compareModeが"auto"の場合、最初の要素を見て数値比較か文字列比較かを自動で決定します。 5. HeapSortCoreを呼び出し、実際のソートを実行させます。 6. ソート結果の配列を戻り値として返します。
引数の重要性	keyColumnとarrDimを決定し、後のサブプロシージャに渡すことで、1次元と2次元の両方を扱えるように準備します。

2. Private Sub HeapSortCore（ソートの実行核）

このサブルーチンは、ヒープソートアルゴリズムの2つの主要ステップを実行する核となる部分です。

	説明
役割	0ベースに変換された配列を受け取り、アルゴリズムの手順通りにソートを実行します。
主な処理	1. 【ヒープ構築】配列を最初（配列の中央付近）から順番にHeapifyを呼び出し、配列を「ヒープ構造」に変えます。 2. 【要素抽出】配列の末尾から先頭に向かってループし、以下の処理を繰り返します。 3. SwapElements で、最大の要素（ルート、インデックス0）を配列の末尾に移動させます。 4. Heapify で、残りの要素（ソート済みを除いた部分）を再度ヒープ構造に修正します。

3. Private Sub Heapify（ヒープ構造の維持）

このサブルーチンは、ヒープソートの基本単位となる処理です。

	説明
役割	特定のルートノード（親）を起点として、その部分木がヒープの条件（親が子よりも大きい/小さい）を満たすように修正します。
主な処理	1. ルートノードと、その2つの子ノード（左の子、右の子）のインデックスを計算します。 2. CompareElements を使って、ルートと子のうち、最も極値（昇順なら最大、降順なら最小）を持つノードを見つけます。 3. 極値がルートノードでなければ、SwapElements でルートノードと極値を持つ子ノードの要素を交換します。 4. 要素を交換した場合、再帰的にHeapifyを呼び出し、交換した子ノードを新しいルートとして再度ヒープの条件を満たすかチェックします。

4. Private Function CompareElements（要素の比較と値の抽出）

この関数は、2次元配列に対応するために最も重要な処理を分岐させている部分です。

	説明
役割	Heapifyから渡された行のインデックスに基づき、比較対象となる「値」を取り出し、CompareValuesに渡して比較結果を返します。
主な処理	1. arrDimをチェックします。 2. 1次元配列なら arr(idx) を値として取り出します。 3. 2次元配列なら arr(idx, keyColumn) を値として取り出します（キー列を指定）。 4. 取り出した2つの値をCompareValuesに渡します。

5. Private Function CompareValues（値の比較ロジック）

この関数は、配列の次元に関係なく、実際の「値」の比較を担当します。

	説明
役割	2つの値（val1とval2）を受け取り、指定された比較モード（text, binary, value）に基づいて大小関係を判定し、TrueまたはFalseを返します。
主な処理	1. "value"モード: IsNumericで判定し、数値として比較します。 2. "text"モード: vbTextCompareで大文字・小文字を区別せず文字列比較します。 3. "binary"モード: vbBinaryCompareで大文字・小文字を区別して文字列比較します。
特徴	この関数は、前のプロシージャで値が適切に抽出されていれば、1次元/2次元配列のどちらのソートでも共通して利用できます。

6. Private Sub SwapElements（要素/行の交換）

このサブルーチンは、ソートの単位（交換対象）を次元に応じて分岐させます。

	説明
役割	指定された2つのインデックス（行番号）の要素または行全体を交換します。
主な処理	1. arrDimをチェックします。 2. 1次元配列の場合、arr(idx1) と arr(idx2) の単一の要素を交換します。 3. 2次元配列の場合、For j = LBound(arr, 2) To UBound(arr, 2) のループを使って、idx1行のすべての列とidx2行のすべての列を交換します。

7. Private Function GetArrayDimensions（配列次元の取得）

	説明
役割	渡された Variant 変数が何次元の配列かを正確に判定して返します。
主な処理	LBound(arr, dimCount)を呼び出し、次元インデックスを増やしていき、エラーが発生した時点でループを抜け、それまでのインデックス数（次元数）を返します。

ヒープソート：1次元/2次元配列対応版の実行テスト


  
    
      '============================================================

      ' HeapSort テストスイート

      '============================================================

      Sub RunAllHeapSortTests()

      　　Debug.Print String(60, "=")

      　　Debug.Print "HEAP SORT TEST SUITE - START"

      　　Debug.Print String(60, "=")

      　　

      　　Test_BasicNumericSorts

      　　Test_BasicStringSorts

      　　Test_BinaryStringSorts

      　　Test_TwoDimensionalArraySort

      　　Test_CompareModes

      　　Test_EdgeCases

      　　Test_NonZeroLBound

      　　Test_ErrorHandling

      　　Test_DebugMode

      　　

      　　Debug.Print String(60, "=")

      　　Debug.Print "HEAP SORT TEST SUITE - COMPLETE"

      　　Debug.Print String(60, "=")

      End Sub



      ' --- テストケース群 ---

      Private Sub Test_BasicNumericSorts()

      　　Debug.Print vbCrLf & "--- 1. 基本的な数値ソート ---"

      　　Dim testArr As Variant

      　　testArr = Array(64, 34, -25, 12, 22, 11, 90, 0)

      　　

      　　Dim expectedAsc As Variant: expectedAsc = Array(-25, 0, 11, 12, 22, 34, 64, 90)

      　　AssertEqual "1-1. 数値 (昇順)", testArr, HeapSort(testArr, , True, "value"), expectedAsc

      　　

      　　Dim expectedDesc As Variant: expectedDesc = Array(90, 64, 34, 22, 12, 11, 0, -25)

      　　AssertEqual "1-2. 数値 (降順)", testArr, HeapSort(testArr, , False, "value"), expectedDesc

      End Sub



      Private Sub Test_BasicStringSorts()

      　　Debug.Print vbCrLf & "--- 2. 基本的な文字列ソート (Textモード/非区別) ---"

      　　Dim testArr As Variant

      　　testArr = Array("banana", "apple", "orange", "grape", "cherry")

      　　

      　　Dim expectedAsc As Variant: expectedAsc = Array("apple", "banana", "cherry", "grape", "orange")

      　　AssertEqual "2-1. 文字列 (Text昇順)", testArr, HeapSort(testArr, , True, "text"), expectedAsc

      　　

      　　Dim expectedDesc As Variant: expectedDesc = Array("orange", "grape", "cherry", "banana", "apple")

      　　AssertEqual "2-2. 文字列 (Text降順)", testArr, HeapSort(testArr, , False, "text"), expectedDesc

      End Sub



      Private Sub Test_BinaryStringSorts()

      　　Debug.Print vbCrLf & "--- 3. 文字列ソート (Binaryモード/区別) ---"

      　　Dim testArr As Variant

      　　testArr = Array("Apple", "apple", "Banana", "banana", "Cherry")

      　　

      　　Dim expectedAsc As Variant: expectedAsc = Array("Apple", "Banana", "Cherry", "apple", "banana")

      　　AssertEqual "3-1. 文字列 (Binary昇順)", testArr, HeapSort(testArr, , True, "binary"), expectedAsc

      　　

      　　Dim expectedDesc As Variant: expectedDesc = Array("banana", "apple", "Cherry", "Banana", "Apple")

      　　AssertEqual "3-2. 文字列 (Binary降順)", testArr, HeapSort(testArr, , False, "binary"), expectedDesc

      End Sub



      Private Sub Test_TwoDimensionalArraySort()

      　　Debug.Print vbCrLf & "--- 4. 2次元配列のソート ---"

      　　

      　　' 2次元配列 (0ベース)

      　　Dim testArr(0 To 4, 0 To 2) As Variant

      　　testArr(0, 0) = 50: testArr(0, 1) = "Banana": testArr(0, 2) = 3

      　　testArr(1, 0) = 10: testArr(1, 1) = "Apple":　testArr(1, 2) = 1

      　　testArr(2, 0) = 40: testArr(2, 1) = "Grape":　testArr(2, 2) = 4

      　　testArr(3, 0) = 20: testArr(3, 1) = "Cherry": testArr(3, 2) = 2

      　　testArr(4, 0) = 30: testArr(4, 1) = "Date":　 testArr(4, 2) = 5

      　　

      　　' 期待結果は1次元の配列の配列として定義（比較関数に合わせて）

      　　Dim expectedArr1 As Variant: expectedArr1 = Array(Array(10, "Apple", 1), Array(20, "Cherry", 2), Array(30, "Date", 5), Array(40, "Grape", 4), Array(50, "Banana", 3))

      　　Dim expectedArr2 As Variant: expectedArr2 = Array(Array(10, "Apple", 1), Array(50, "Banana", 3), Array(20, "Cherry", 2), Array(30, "Date", 5), Array(40, "Grape", 4))

      　　Dim expectedArr3 As Variant: expectedArr3 = Array(Array(30, "Date", 5), Array(40, "Grape", 4), Array(50, "Banana", 3), Array(20, "Cherry", 2), Array(10, "Apple", 1))



      　　' 0列目 (インデックス0) でソート

      　　AssertEqual2D "4-1. 2D: 0列目(数値)昇順", testArr, HeapSort(testArr, 0, True, "value"), expectedArr1

      　　

      　　' 1列目 (インデックス1) でソート

      　　AssertEqual2D "4-2. 2D: 1列目(文字列)昇順", testArr, HeapSort(testArr, 1, True, "text"), expectedArr2



      　　' 2列目 (インデックス2) で降順ソート

      　　AssertEqual2D "4-3. 2D: 2列目(数値)降順", testArr, HeapSort(testArr, 2, False, "value"), expectedArr3

      End Sub



      Private Sub Test_CompareModes()

      　　Debug.Print vbCrLf & "--- 5. 比較モードのテスト ---"

      　　Dim testArr As Variant: testArr = Array("10", 2, "1", 100, "25")



      　　Dim expectedAuto As Variant: expectedAuto = Array("1", 2, "10", "25", 100)

      　　AssertEqual "5-1. 混在データ (auto)", testArr, HeapSort(testArr), expectedAuto



      　　Dim expectedValue As Variant: expectedValue = Array("1", 2, "10", "25", 100)

      　　AssertEqual "5-2. 混在データ (value)", testArr, HeapSort(testArr, , True, "value"), expectedValue

      　　

      　　Dim expectedText As Variant: expectedText = Array("1", "10", 100, 2, "25")

      　　AssertEqual "5-3. 混在データ (text)", testArr, HeapSort(testArr, , True, "text"), expectedText

      End Sub



      Private Sub Test_EdgeCases()

      　　Debug.Print vbCrLf & "--- 6. エッジケースのテスト ---"

      　　Dim testArr As Variant, expectedArr As Variant



      　　testArr = Array(): expectedArr = Array()

      　　AssertEqual "6-1. 空の配列", testArr, HeapSort(testArr), expectedArr

      　　

      　　testArr = Array(100): expectedArr = Array(100)

      　　AssertEqual "6-2. 要素が1つの配列", testArr, HeapSort(testArr), expectedArr



      　　testArr = Array(5, 2, 8, 2, 5, 1): expectedArr = Array(1, 2, 2, 5, 5, 8)

      　　AssertEqual "6-3. 重複する値を含む配列", testArr, HeapSort(testArr), expectedArr

      　　

      　　testArr = Array(10, 20, 30, 40, 50): expectedArr = Array(10, 20, 30, 40, 50)

      　　AssertEqual "6-4. 既に昇順ソート済みの配列", testArr, HeapSort(testArr), expectedArr



      　　testArr = Array(50, 40, 30, 20, 10): expectedArr = Array(10, 20, 30, 40, 50)

      　　AssertEqual "6-5. 既に降順ソート済みの配列 (昇順へ)", testArr, HeapSort(testArr), expectedArr

      End Sub



      Private Sub Test_NonZeroLBound()

      　　Debug.Print vbCrLf & "--- 7. 0以外のLBoundを持つ配列 ---"

      　　Dim testArr(5 To 10) As Long

      　　testArr(5) = 99: testArr(6) = 15: testArr(7) = 42

      　　testArr(8) = 7: testArr(9) = 88: testArr(10) = 30



      　　Dim expectedArr As Variant: expectedArr = Array(7, 15, 30, 42, 88, 99)

      　　AssertEqual "7-1. LBoundが5の配列", testArr, HeapSort(testArr), expectedArr

      End Sub



      Private Sub Test_ErrorHandling()

      　　Debug.Print vbCrLf & "--- 8. エラーハンドリング ---"

      　　Dim result As Variant

      　　

      　　result = HeapSort("not an array")

      　　If IsError(result) And result = CVErr(xlErrValue) Then

      　　　　Debug.Print "8-1. 非配列の引数　　　: PASS - 正常にエラー値を返しました。"

      　　Else

      　　　　Debug.Print "8-1. 非配列の引数　　　: FAIL - エラーを検知できませんでした。"

      　　End If

      　　

      　　result = HeapSort(Array(1, 2), , True, "invalid_mode")

      　　If IsError(result) And result = CVErr(xlErrValue) Then

      　　　　Debug.Print "8-2. 不正なcompareMode　　 : PASS - 正常にエラー値を返しました。"

      　　Else

      　　　　Debug.Print "8-2. 不正なcompareMode　　 : FAIL - エラーを検知できませんでした。"

      　　End If

      End Sub



      Private Sub Test_DebugMode()

      　　Debug.Print vbCrLf & "--- 9. デバッグモードのテスト ---"

      　　Dim testArr As Variant: testArr = Array(3, 1, 2)

      　　Call HeapSort(testArr, , True, "auto", True)

      End Sub



      ' --- テスト結果を比較・表示するためのヘルパー ---



      Private Sub AssertEqual(ByVal testName As String, _

      　　　　　　　　　　　　 ByVal originalArr As Variant, _

      　　　　　　　　　　　　 ByVal actualResult As Variant, _

      　　　　　　　　　　　　 ByVal expectedResult As Variant)



      　　Debug.Print testName

      　　

      　　Dim originalArrStr As String

      　　originalArrStr = CustomJoin(originalArr, ", ") ' 1D/2D対応のCustomJoinを使用



      　　Debug.Print "　- 元の配列:　　" & originalArrStr



      　　If IsError(actualResult) Then

      　　　　Debug.Print "　- 実行結果:　　エラー値 (" & CStr(actualResult) & ")"

      　　　　Debug.Print "　- 期待結果:　　" & CustomJoin(expectedResult, ", ")

      　　　　Debug.Print "　- 結果:　　　　FAIL ★★★"

      　　　　Exit Sub

      　　End If

      　　

      　　Dim actualStr As String, expectedStr As String

      　　

      　　actualStr = CustomJoin(actualResult, ", ")

      　　expectedStr = CustomJoin(expectedResult, ", ")

      　　

      　　If actualStr = expectedStr Then

      　　　　Debug.Print "　- 実行結果:　　" & actualStr

      　　　　Debug.Print "　- 結果:　　　　PASS"

      　　Else

      　　　　Debug.Print "　- 実行結果:　　" & actualStr

      　　　　Debug.Print "　- 期待結果:　　" & expectedStr

      　　　　Debug.Print "　- 結果:　　　　FAIL ★★★"

      　　End If

      End Sub



      ' 2次元配列用のAssertEqual

      Private Sub AssertEqual2D(ByVal testName As String, _

      　　　　　　　　　　　　 ByVal originalArr As Variant, _

      　　　　　　　　　　　　 ByVal actualResult As Variant, _

      　　　　　　　　　　　　 ByVal expectedResult As Variant)

      　　

      　　Debug.Print testName

      　　

      　　' 2次元配列の元の配列の出力は複雑なため、最初の列のみを出力

      　　Debug.Print "　- 元の配列(1列目): " & CustomJoin(originalArr, ", ")



      　　If IsError(actualResult) Then

      　　　　Debug.Print "　- 実行結果:　　エラー値 (" & CStr(actualResult) & ")"

      　　　　Debug.Print "　- 結果:　　　　FAIL ★★★"

      　　　　Exit Sub

      　　End If

      　　

      　　Dim isMatch As Boolean

      　　isMatch = CompareTwoDArrays(actualResult, expectedResult)



      　　If isMatch Then

      　　　　Debug.Print "　- 実行結果:　　PASS (2D配列の構造と値が一致)"

      　　　　Debug.Print "　- 結果:　　　　PASS"

      　　Else

      　　　　' 期待結果は1次元配列の配列として定義されているため、比較結果の出力は省略

      　　　　Debug.Print "　- 実行結果:　　FAIL (2D配列の構造または値が不一致)"

      　　　　Debug.Print "　- 結果:　　　　FAIL ★★★"

      　　End If

      End Sub



      ' 2次元配列の構造と要素を比較するヘルパー関数

      Private Function CompareTwoDArrays(arr1 As Variant, arr2 As Variant) As Boolean

      　　On Error GoTo ErrorHandler

      　　

      　　' 1次元目のサイズチェック (arr2は配列の配列なのでLBound/UBound(arr2, 2)はエラーになる)

      　　If UBound(arr1, 1) <> UBound(arr2) Or LBound(arr1, 1) <> LBound(arr2) Then GoTo ExitFalse

      　　

      　　Dim i As Long, j As Long

      　　Dim uB2_1 As Long, uB2_2 As Long ' 2次元目の範囲

      　　uB2_1 = UBound(arr1, 2)

      　　

      　　For i = LBound(arr1, 1) To UBound(arr1, 1)

      　　　　' 2次元目のサイズチェック

      　　　　If UBound(arr2(i)) <> uB2_1 Then GoTo ExitFalse

      　　　　

      　　　　For j = LBound(arr1, 2) To UBound(arr1, 2)

      　　　　　　If CStr(arr1(i, j)) <> CStr(arr2(i)(j)) Then GoTo ExitFalse ' arr2は配列の配列としてアクセス

      　　　　Next j

      　　Next i

      　　

      　　CompareTwoDArrays = True

      　　Exit Function



      ExitFalse:

      　　CompareTwoDArrays = False

      　　Exit Function



      ErrorHandler:

      　　CompareTwoDArrays = False

      End Function



      '------------------------------------------------------------

      ' CustomJoin関数 (1D/2D対応の修正済み)

      '------------------------------------------------------------

      Private Function CustomJoin(arr As Variant, delimiter As String) As String

      　　Dim i As Long

      　　Dim tempArr() As String

      　　Dim arrDim As Long

      　　

      　　If Not IsArray(arr) Then

      　　　　CustomJoin = CStr(arr)

      　　　　Exit Function

      　　End If

      　　

      　　arrDim = GetArrayDimensions(arr)

      　　

      　　If arrDim = 1 Then

      　　　　If UBound(arr) < LBound(arr) Then Exit Function

      　　　　ReDim tempArr(LBound(arr) To UBound(arr))

      　　　　For i = LBound(arr) To UBound(arr)

      　　　　　　On Error Resume Next

      　　　　　　tempArr(i) = CStr(arr(i))

      　　　　　　On Error GoTo 0

      　　　　Next i

      　　　　CustomJoin = Join(tempArr, delimiter)

      　　ElseIf arrDim = 2 Then

      　　　　' 2次元配列の場合 (1列目/LBound(arr, 2) の要素のみを結合)

      　　　　Dim lB1 As Long, uB1 As Long, lB2 As Long

      　　　　lB1 = LBound(arr, 1): uB1 = UBound(arr, 1)

      　　　　

      　　　　On Error Resume Next

      　　　　lB2 = LBound(arr, 2)

      　　　　If Err.Number <> 0 Then lB2 = 0 ' 2次元目のLBound取得エラー対策

      　　　　On Error GoTo 0

      　　　　

      　　　　If uB1 < lB1 Then Exit Function

      　　　　ReDim tempArr(lB1 To uB1)

      　　　　

      　　　　For i = lB1 To uB1

      　　　　　　On Error Resume Next

      　　　　　　tempArr(i) = CStr(arr(i, lB2)) ' 常に2次元目のLBound(最初の列)の値を結合

      　　　　　　On Error GoTo 0

      　　　　Next i

      　　　　CustomJoin = Join(tempArr, delimiter)

      　　End If

      End Function

VBAコードの解説

プロシージャ名	役割	テスト内容
RunAllHeapSortTests	全体の実行管理	すべてのテストプロシージャを順番に呼び出し、テストスイートの開始・終了ログを出力します。
Test_BasicNumericSorts	数値基本テスト	正負の数を含む1次元配列に対し、昇順・降順ソートの正確性を検証します。
Test_BasicStringSorts	文字列 (Text) テスト	文字列の1次元配列に対し、大文字小文字を区別しないソート ("text") を検証します。
Test_BinaryStringSorts	文字列 (Binary) テスト	大文字小文字を区別するソート ("binary") が文字コード順に正しく行われるかを検証します。
Test_TwoDimensionalArraySort	2次元配列テスト	2次元配列に対し、keyColumn を変えて（数値列、文字列列など）ソートの正確性を検証します。
Test_CompareModes	比較モードテスト	数値と文字列が混在した配列に対し、"auto", "value", "text" の各モードのソート結果を検証します。
Test_EdgeCases	エッジケーステスト	空の配列、単一要素、重複値、既にソート済み、逆順の配列など、境界条件での動作を検証します。
Test_NonZeroLBound	LBoundテスト	インデックスが0以外（例：LBoundが5）の配列が正しく処理されるかを検証します。
Test_ErrorHandling	エラー処理テスト	非配列引数や不正な比較モードなど、エラーが発生すべき場合に、関数がエラー値を返すかを検証します。
Test_DebugMode	デバッグモードテスト	enableDebug=Trueとした際に、ソートの詳細なログがイミディエイトウィンドウに正しく出力されるかを検証します。
AssertEqual / AssertEqual2D	結果比較ヘルパー	実行結果と期待結果を比較し、PASS または FAIL を判定してログを出力します。

テストコードの実行結果

============================================================
HEAP SORT TEST SUITE - START
============================================================

--- 1. 基本的な数値ソート ---
1-1. 数値 (昇順)
  - 元の配列:    64, 34, -25, 12, 22, 11, 90, 0
  - 実行結果:    -25, 0, 11, 12, 22, 34, 64, 90
  - 結果:        PASS
1-2. 数値 (降順)
  - 元の配列:    64, 34, -25, 12, 22, 11, 90, 0
  - 実行結果:    90, 64, 34, 22, 12, 11, 0, -25
  - 結果:        PASS

--- 2. 基本的な文字列ソート (Textモード/非区別) ---
2-1. 文字列 (Text昇順)
  - 元の配列:    banana, apple, orange, grape, cherry
  - 実行結果:    apple, banana, cherry, grape, orange
  - 結果:        PASS
2-2. 文字列 (Text降順)
  - 元の配列:    banana, apple, orange, grape, cherry
  - 実行結果:    orange, grape, cherry, banana, apple
  - 結果:        PASS

--- 3. 文字列ソート (Binaryモード/区別) ---
3-1. 文字列 (Binary昇順)
  - 元の配列:    Apple, apple, Banana, banana, Cherry
  - 実行結果:    Apple, Banana, Cherry, apple, banana
  - 結果:        PASS
3-2. 文字列 (Binary降順)
  - 元の配列:    Apple, apple, Banana, banana, Cherry
  - 実行結果:    banana, apple, Cherry, Banana, Apple
  - 結果:        PASS

--- 4. 2次元配列のソート ---
4-1. 2D: 0列目(数値)昇順
  - 元の配列(1列目): 50, 10, 40, 20, 30
  - 実行結果:    PASS (2D配列の構造と値が一致)
  - 結果:        PASS
4-2. 2D: 1列目(文字列)昇順
  - 元の配列(1列目): 50, 10, 40, 20, 30
  - 実行結果:    PASS (2D配列の構造と値が一致)
  - 結果:        PASS
4-3. 2D: 2列目(数値)降順
  - 元の配列(1列目): 50, 10, 40, 20, 30
  - 実行結果:    PASS (2D配列の構造と値が一致)
  - 結果:        PASS

--- 5. 比較モードのテスト ---
5-1. 混在データ (auto)
  - 元の配列:    10, 2, 1, 100, 25
  - 実行結果:    1, 2, 10, 25, 100
  - 結果:        PASS
5-2. 混在データ (value)
  - 元の配列:    10, 2, 1, 100, 25
  - 実行結果:    1, 2, 10, 25, 100
  - 結果:        PASS
5-3. 混在データ (text)
  - 元の配列:    10, 2, 1, 100, 25
  - 実行結果:    1, 10, 100, 2, 25
  - 結果:        PASS

--- 6. エッジケースのテスト ---
6-1. 空の配列
  - 元の配列:    
  - 実行結果:    
  - 結果:        PASS
6-2. 要素が1つの配列
  - 元の配列:    100
  - 実行結果:    100
  - 結果:        PASS
6-3. 重複する値を含む配列
  - 元の配列:    5, 2, 8, 2, 5, 1
  - 実行結果:    1, 2, 2, 5, 5, 8
  - 結果:        PASS
6-4. 既に昇順ソート済みの配列
  - 元の配列:    10, 20, 30, 40, 50
  - 実行結果:    10, 20, 30, 40, 50
  - 結果:        PASS
6-5. 既に降順ソート済みの配列 (昇順へ)
  - 元の配列:    50, 40, 30, 20, 10
  - 実行結果:    10, 20, 30, 40, 50
  - 結果:        PASS

--- 7. 0以外のLBoundを持つ配列 ---
7-1. LBoundが5の配列
  - 元の配列:    99, 15, 42, 7, 88, 30
  - 実行結果:    7, 15, 30, 42, 88, 99
  - 結果:        PASS

--- 8. エラーハンドリング ---
8-1. 非配列の引数      : PASS - 正常にエラー値を返しました。
8-2. 不正なcompareMode     : PASS - 正常にエラー値を返しました。

--- 9. デバッグモードのテスト ---
------------------------------------------------------------
【HeapSort 開始】
昇順/降順: 昇順
compareMode: auto
配列要素数 (行数):  3 
compareMode自動判定結果: value
【HeapSort 終了】
------------------------------------------------------------
============================================================
HEAP SORT TEST SUITE - COMPLETE
============================================================

すべてのテストケースが期待通りに動作しました。

サイト内関連ページ

1次元配列の並べ替え（バブルソート,挿入ソート、クイックソート）

・検証方法・バブルソート・挿入ソート・クイックソート・最後に

2次元配列の並べ替え（バブルソート,クイックソート）

・検証方法・バブルソート・クイックソート・複数キーでの並べ替えについて・ワークシートを使って並べ替え・・・番外編

同じテーマ「マクロVBAサンプル集」の記事

1次元配列の並べ替え（バブルソート,挿入ソート,クイックソート）
2次元配列の並べ替え（バブルソート,クイックソート）
Dir関数で全サブフォルダの全ファイルを取得
 順列の全組み合わせ作成と応用方法
 スピルに対応したXSPLITユーザー定義関数（文字区切り）
ヒープソートのサンプルVBA：1次元/2次元配列対応版

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

ホーム
マクロVBA応用編
マクロVBAサンプル集
ヒープソートのサンプルVBA：1次元/2次元配列対応版

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBAサンプル集
ヒープソートのサンプルVBA：1次元/2次元配列対応版