アフィリエイト・アドセンス広告を利用しています。詳細は こちら



Excel VBA - 2次元配列 - 行・列方向 - 昇順・降順クイックソート(単一キー)処理メモ

Excel VBA でネット上で公開されているクイックソートを使った VBA サンプルコードを公開します。

Excel と Excel Visual Basic Editor(VBE)の環境設定については 以前公開した記事 より、VBA コードの基本的な内容については こちらの記事 よりご確認ください。

Excel VBA - 2次元配列 - 行・列方向 - 昇順・降順クイックソート(単一キー)処理メモ


クイックソート用サンプルファイル(xlsx ファイル)

クイックソート用のサンプルファイル(xlsx ファイル)を公開します。

サンプルデータは Start Point さんのところで公開しているコピペで使える都道府県一覧リスト・県庁所在地一覧 を加工しています。

こちらで作成した クイックソートA.xlsx ファイルクイックソートB.xlsx ファイル を用意しました。ファイル名リンクをクリックすると Google ドライブからダウンロードするようにしています。

クイックソートA.xlsx ファイル は VBA コードを実行する前の状態、クイックソートB.xlsx ファイル は VBA コード実行後の処理結果内容となっています。

いずれも xlsx ファイルとなっており VBA コードは含まれていません。VBA コードを実行するにはファイル拡張子が xlsm(マクロ有効ブック)となっている必要がありますが、xlsm 形式での配布は念のため避けています。

VBA コードを実行するには クイックソートA.xlsx ファイル をダウンロード後 xlsm 形式に保存、以降各セクションで紹介している VBA コードを各自追加して実行してもらう形としています。

VBA コードの追加方法は VBE のプロジェクトエクスプローラー(Ctrl + R キー)画面にて、開いている VBAProject(ファイル名.xlsm)→「標準モジュール」を開き、右クリックから「挿入」→「標準モジュール」でクリック、追加した標準モジュールに VBA コードを貼り付けることで動作できるようにしています。

クイックソート用 VBA コードと詳細な内容については 次のセクション から説明します。

2次元配列 - 単一キー - 行方向 - 昇順・降順クイックソート VBA サンプルコード

以下、2次元配列を対象に指定した単一キーで行方向に昇順・降順クイックソートする VBA サンプルコードです。列方向に昇順・降順クイックソートする VBA サンプルコードについては こちら で説明します。

2次元配列用クイックソート VBA プログラムを別モジュール(標準モジュール)に登録して、Call ステートメントを使って呼び出してクイックソートします。

VBA 用クイックソートプログラムはいろいろなところで公開・解説されていていますが、コードは大体同じ内容となっています。この記事で紹介する 2次元配列用クイックソート VBA プログラムについては、エクセルの神髄さんのところで公開している 2次元配列に対応したクイックソートプログラム を一部変更(アルゴリズム部分は変更なし)して使います。

ここではクイックソートのみを行うプログラムと、ソート対象を 2次元配列に格納してクイックソートプログラムを呼び出すプログラムを別々のモジュールに分ける形で紹介します。(関連記事

今回の VBA コードではシート「都道府県県庁所在地地方区分ランダム並べ替え」を 2次元配列に格納して、A 列にある都道府県コードを単一キーとしてクイックソートで並べ替えるだけの内容となっています。

2次元配列のデータをクイックソート後、シート「クイックソート」に転記します。クイックソート後の転記先セル内容が確認できるように、転記先シートの該当セルにあらかじめ罫線を囲んであります。

クイックソート処理部分以外の基本的な VBA コードについては 以前公開した記事内容 を参照してください。

次のセクション から 2次元配列の単一キーで、クイックソートを使った VBA コード部分について(ソートアルゴリズム部分を除く)内容を説明します。

その他について以前公開した VBA コードで、LBound と UBound 関数のパラメーターとして配列を返す関数(Split 関数など)を使用すると、メモリリークが起きる可能性があるとの指摘がありました。

ただ、VBA コードのメモリリークについて日本語で言及している情報が少なく、今回公開した VBA コードが原因でメモリリークが起きるかどうか確認できていません。(こちらで単純にメモリリークに気づいていないというのもあります)

こちらのサイト ではメモリリークする・しないコードの書き方が紹介されています。この記事ではこの書き方にならってメモリリーク対策した VBA コードにしています。メモリリークが起きないとされているコード内容に修正しただけなので、実際にメモリリークが起きないかどうかまでは確認していません。

基本的に関数の返り値を一度変数に格納して、その変数を使用する方法に書き換えた内容となっています。メモリリークに対策したコード個所についてはハイライトで表示しておきます。

Option Explicit

Sub QuickSortAscRows(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long, ByVal keyPos As Long)
  ' クイックソート(昇順・行方向)(メモリリーク対策版)
  ' 参考サイト:2次元配列の並べ替え(バブルソート,クイックソート)https://excel-ubara.com/excelvba5/EXCELVBA229.html

  Dim i As Long, j As Long, k As Long
  Dim vBase As Variant, vSwap As Variant

  vBase = argAry(Int((lngMin + lngMax) / 2), keyPos)

  i = lngMin
  j = lngMax

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_argAry_2D As Variant, UB_argAry_2D As Variant
  LB_argAry_2D = LBound(argAry, 2)
  UB_argAry_2D = UBound(argAry, 2)

  Do
    Do While argAry(i, keyPos) < vBase ' 昇順
      i = i + 1
    Loop

    Do While argAry(j, keyPos) > vBase ' 昇順
      j = j - 1
    Loop

    If i >= j Then Exit Do

    For k = LB_argAry_2D To UB_argAry_2D
      vSwap = argAry(i, k)
      argAry(i, k) = argAry(j, k)
      argAry(j, k) = vSwap
    Next k

    i = i + 1
    j = j - 1
  Loop
  
  If (lngMin < i - 1) Then
    Call QuickSortAscRows(argAry, lngMin, i - 1, keyPos)
  End If

  If (lngMax > j + 1) Then
    Call QuickSortAscRows(argAry, j + 1, lngMax, keyPos)
  End If

End Sub
Option Explicit

Sub QuickSortDescRows(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long, ByVal keyPos As Long)
  ' クイックソート(降順・行方向)(メモリリーク対策版)
  ' 参考サイト:2次元配列の並べ替え(バブルソート,クイックソート)https://excel-ubara.com/excelvba5/EXCELVBA229.html

  Dim i As Long, j As Long, k As Long
  Dim vBase As Variant, vSwap As Variant

  vBase = argAry(Int((lngMin + lngMax) / 2), keyPos)

  i = lngMin
  j = lngMax

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_argAry_2D As Variant, UB_argAry_2D As Variant
  LB_argAry_2D = LBound(argAry, 2)
  UB_argAry_2D = UBound(argAry, 2)

  Do
    Do While argAry(i, keyPos) > vBase ' 降順
      i = i + 1
    Loop

    Do While argAry(j, keyPos) < vBase ' 降順
      j = j - 1
    Loop

    If i >= j Then Exit Do

    For k = LB_argAry_2D To UB_argAry_2D
      vSwap = argAry(i, k)
      argAry(i, k) = argAry(j, k)
      argAry(j, k) = vSwap
    Next k

    i = i + 1
    j = j - 1
  Loop
  
  If (lngMin < i - 1) Then
    Call QuickSortDescRows(argAry, lngMin, i - 1, keyPos)
  End If

  If (lngMax > j + 1) Then
    Call QuickSortDescRows(argAry, j + 1, lngMax, keyPos)
  End If

End Sub
Option Explicit

Sub QuickSortSingleKeyRowsFixMemoryLeaks() ' メモリリーク対策版
  ' シート「都道府県県庁所在地地方区分ランダム並べ替え」内容をシート上で並べ替えずに、2次元配列を使ってクイックソートで行方向並べ替え

  ' 実行速度計測開始
  Dim starttime As Double
  starttime = Timer

' ----------

  ' 変数宣言
  Dim i As Long, k As Long ' カウンタ用変数(一見見分けにくい文字同士を組み合わせない形、i と j、m と n、o(オー) と 0(ゼロ))

' ----------

  ' 変数宣言
  Dim ws1 As Worksheet ' シート格納用オブジェクト変数

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え") ' ソート元シートをオブジェクト変数にセット

  Dim maxrow1 As Long ' 最終行取得用変数
  Dim maxcol1 As Long ' 最終列取得用変数

  ' シートの最終行・最終列を取得して変数に格納
  maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).row
  maxcol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

  ' 変数宣言
  Dim arr1() As Variant ' ソート対象データ格納用動的配列

  ' シートの指定した範囲内セルを配列としてバリアント型動的配列に格納
  arr1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  arr1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_arr1_1D As Variant, UB_arr1_1D As Variant
  Dim LB_arr1_2D As Variant, UB_arr1_2D As Variant
  LB_arr1_1D = LBound(arr1, 1)
  UB_arr1_1D = UBound(arr1, 1)
  LB_arr1_2D = LBound(arr1, 2)
  UB_arr1_2D = UBound(arr1, 2)

  ' クイックソート(昇順・行方向)
  Call QuickSortAscRows.QuickSortAscRows(arr1, LB_arr1_1D, UB_arr1_1D, 1)

  ' クイックソート(降順・行方向)
'  Call QuickSortDescRows.QuickSortDescRows(arr1, LB_arr1_1D, UB_arr1_1D, 1)

' ----------

  ' 変数宣言
  Dim ws2 As Worksheet ' シート格納用オブジェクト変数

  ' オブジェクト変数にシートセット
  Set ws2 = ThisWorkbook.Worksheets("クイックソート") ' 転記先シートをオブジェクト変数にセット

  ' 二次元配列 data2 の内容を、貼り付け先シートの Range で指定したセルから Resize で範囲を変更してセルに代入
  ws2.Range("A2").Resize(UB_arr1_1D, UB_arr1_2D) = arr1
  ws2.Activate

' ----------

  ' 実行速度計測結果表示
  Debug.Print Format(Timer - starttime, "0.00秒")

End Sub

2次元配列用 - 行方向 - 昇順・降順クイックソート VBA プログラム

Option Explicit

Sub QuickSortAscRows(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long, ByVal keyPos As Long)
  ' クイックソート(昇順・行方向)(メモリリーク対策版)
  ' 参考サイト:2次元配列の並べ替え(バブルソート,クイックソート)https://excel-ubara.com/excelvba5/EXCELVBA229.html

  Dim i As Long, j As Long, k As Long
  Dim vBase As Variant, vSwap As Variant

  vBase = argAry(Int((lngMin + lngMax) / 2), keyPos)

  i = lngMin
  j = lngMax

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_argAry_2D As Variant, UB_argAry_2D As Variant
  LB_argAry_2D = LBound(argAry, 2)
  UB_argAry_2D = UBound(argAry, 2)

  Do
    Do While argAry(i, keyPos) < vBase ' 昇順
      i = i + 1
    Loop

    Do While argAry(j, keyPos) > vBase ' 昇順
      j = j - 1
    Loop

    If i >= j Then Exit Do

    For k = LB_argAry_2D To UB_argAry_2D
      vSwap = argAry(i, k)
      argAry(i, k) = argAry(j, k)
      argAry(j, k) = vSwap
    Next k

    i = i + 1
    j = j - 1
  Loop
  
  If (lngMin < i - 1) Then
    Call QuickSortAscRows(argAry, lngMin, i - 1, keyPos)
  End If

  If (lngMax > j + 1) Then
    Call QuickSortAscRows(argAry, j + 1, lngMax, keyPos)
  End If

End Sub
Option Explicit

Sub QuickSortDescRows(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long, ByVal keyPos As Long)
  ' クイックソート(降順・行方向)(メモリリーク対策版)
  ' 参考サイト:2次元配列の並べ替え(バブルソート,クイックソート)https://excel-ubara.com/excelvba5/EXCELVBA229.html

  Dim i As Long, j As Long, k As Long
  Dim vBase As Variant, vSwap As Variant

  vBase = argAry(Int((lngMin + lngMax) / 2), keyPos)

  i = lngMin
  j = lngMax

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_argAry_2D As Variant, UB_argAry_2D As Variant
  LB_argAry_2D = LBound(argAry, 2)
  UB_argAry_2D = UBound(argAry, 2)

  Do
    Do While argAry(i, keyPos) > vBase ' 降順
      i = i + 1
    Loop

    Do While argAry(j, keyPos) < vBase ' 降順
      j = j - 1
    Loop

    If i >= j Then Exit Do

    For k = LB_argAry_2D To UB_argAry_2D
      vSwap = argAry(i, k)
      argAry(i, k) = argAry(j, k)
      argAry(j, k) = vSwap
    Next k

    i = i + 1
    j = j - 1
  Loop
  
  If (lngMin < i - 1) Then
    Call QuickSortDescRows(argAry, lngMin, i - 1, keyPos)
  End If

  If (lngMax > j + 1) Then
    Call QuickSortDescRows(argAry, j + 1, lngMax, keyPos)
  End If

End Sub

2次元配列用 - 行方向 - 昇順・降順クイックソート VBA プログラムです。内容は エクセルの神髄さんのところで公開されている 2次元配列用クイックソートプログラム と同じで一部変更(アルゴリズム部分は変更なし)して使用します。

このクイックソート VBA プログラムを使うのにあたって次の点に変更を加えています。

プロシージャ名の変更(日本語→英語)、変数宣言を 1行 1変数から 1行複数変数宣言にまとめて整理、インデント・改行調整、16~18行目にメモリリーク対策として LBound・UBound 関数格納用変数の宣言と代入をしています。

クイックソートを呼び出す側のプログラム から複数の引数を受け取りクイックソート処理をします。

上記の呼び出されたクイックソート VBA プログラムに応じて、指定したソートキーを昇順または降順で並び替えます。21行目と 25行目それぞれの不等号を逆にするだけで昇順・降順に並び替えを変更することができます。


このクイックソートプログラムを含め、ネット上で公開されている VBA 用クイックソートプログラムは、単一キーを対象としたものがほとんどです。複数キーの組み合わせを指定してソートする方法はこちらで確認した限りでは数える程度しかないようです。(バブルソートで複数キーを指定する方法がありますが、大量のデータを並べ替えするには処理速度が遅いため取り上げていません)

以下の参考サイトでは複数キーを指定してクイックソートする方法が紹介されています。やり方はソート対象のキーの桁数をそろえて順番にキーを結合、これをソート対象のキーとすることで複数キーを条件とした並べ替え相当が可能といった内容となっています。

気になる点としてはそれぞれのキーに昇順・降順を指定したい場合に、意図した並べ替えはできないのではないか?というのがあります。

上記の複数のソートキーの桁数をそろえて、キーを結合したソートプログラムを組んでいないので、実際に動作確認してみないとわからないところがありますが、例えば複数キーの先頭から途中までは昇順指定で同値だった場合に、同値同士で後ろ側や最後にあるキーは降順にしたいといったことはおそらく対応できないのではないかと思われます。(結合したキーは単一キーとしてみるので昇順・降順の 2択しかないため)

以下の参考サイトでは複数キーに対応したクイックソートの VBA コードが公開されています。ただ、サンプルで用意された並べ替え対象のデータが列挙型(Enum)となっており 2次元配列を使っていません。

こちらで 2次元配列に対応したコードの作成を試みましたが、思うような並べ替え(それぞれのキーに昇順・降順を指定した並べ替え)ができなかったため諦めています。

Microsoft 365 や Excel 2021 を使用している環境であれば、SortBy 関数を使うことでソートプログラムを使うことなく複数キーのソートに対応できます。

気になる点として こちらの動画 でのやり方では、VBA コード内で配列から並べ替え対象となる必要なキーを取得して、それを SortBy 関数の引数に順番に指定と、対になる形で昇順・降順どちらかをセットで指定するようになっています。

並べ替え対象となるキーが常に決まっている・決まったキーで指定したソートができればよい、という条件であればコードが短く済みこれで十分かもしれません。ただ、並べ替え対象が常に可変で自由に複数のキーを昇順・降順に指定したいとなった場合に、その都度 VBA コードを書き直さなければならない点が考えられます。

Sortby 関数への複数の引数の指定方法を VBA コードを編集することなく、自由に複数のソートキーと昇順・降順を指定する方法がないと、ソート条件を毎回変更する場合は使いにくいかもしれないといった印象です。

もし VBA コード内容を自動的に書き換えたい場合は こちらこちら のサイトにある方法を使うことになるかと思われます。

以下の参考サイトでは 2次元配列の複数キーに対応したマージソートの VBA コードが公開されています。

昇順・降順用の Sub プロシージャが用意されており、それぞれのキーに対して昇順・降順どちらかを指定して順番にプロシージャを呼び出すだけで、柔軟に並べ替えることが可能となっています。

データ量によっては処理速度でクイックソートに一歩及ばないところがありますが、Microsoft 365 や Excel 2021 の Sortby 関数が使えない環境であれば、VBA で複数キーにも対応したソートプログラムとして使うには使い勝手がよく十分かと思います。

2023/12/22 追記

Excel VBA でマージソートする記事を公開 しました。

Excel で Power Query が使えるバージョンであれば、Power Query で複数列を昇順・降順に並び替えることができます。

Excel によるデータを並び替える方法はいろいろあるので、その中から目的にあったものを選んで使うことになります。

配列の並び替えについては下記の動画にあるように一筋縄ではいかないところがあるので、上記の方法をとらない・とれないのであれば、(元データを変更しないようにするなどであれば)シートを複製してシート上で並び替える VBA コード作成や、Power Query を使って並べ替えをすることになるでしょう。

2次元配列用 - 行方向 - 昇順・降順クイックソート呼び出し VBA サンプルコード

  ' 変数宣言
  Dim arr1() As Variant ' ソート対象データ格納用動的配列

  ' シートの指定した範囲内セルを配列としてバリアント型動的配列に格納
  arr1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  arr1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_arr1_1D As Variant, UB_arr1_1D As Variant
  Dim LB_arr1_2D As Variant, UB_arr1_2D As Variant
  LB_arr1_1D = LBound(arr1, 1)
  UB_arr1_1D = UBound(arr1, 1)
  LB_arr1_2D = LBound(arr1, 2)
  UB_arr1_2D = UBound(arr1, 2)

  ' クイックソート(昇順・行方向)
  Call QuickSortAscRows.QuickSortAscRows(arr1, LB_arr1_1D, UB_arr1_1D, 1)

  ' クイックソート(降順・行方向)
'  Call QuickSortDescRows.QuickSortDescRows(arr1, LB_arr1_1D, UB_arr1_1D, 1)

並び替え対象のデータを格納した 2次元配列を引数としてクイックソートプログラムを呼び出します。

48行目または 51行目の Call ステートメントで 4つの引数を指定した 2次元配列用昇順・降順クイックソートプロシージャ を呼び出します。

1つ目の引数には 34行目でソート対象のデータを格納した 2次元配列 arr1 を指定します。

2つ目の引数には LBound 関数でソート対象のデータを格納した 2次元配列の最小要素番号を指定します。ここでは 42行目で LBound 関数の返り値を格納した変数 LB_arr1 を指定しています。

3つ目の引数には UBound 関数でソート対象のデータを格納した 2次元配列の最大要素番号を指定します。ここでは 43行目で UBound 関数の返り値を格納した変数 UB_arr1 を指定しています。

4つ目の引数にはソート対象のキーとなる 2次元配列の列番号を指定します。1 と指定した場合は 2次元配列の 1列目にあたる「都道府県コード」がソート対象となります。

2次元配列 - 単一キー - 列方向 - 昇順・降順クイックソート VBA サンプルコード

以下、2次元配列を対象に指定した単一キーで列方向に昇順・降順クイックソートする VBA サンプルコードです。

並び替えの一般的な使い方としては、指定した列をキーとして各行を昇順・降順で並び替えることかと思いますが、こちらは指定した行をキーとして各列を昇順・降順に並び替えることができます。

行方向の昇順・降順クイックソートプログラム と基本的に同じコード(アルゴリズム)内容のままで、プログラム内にある 2次元配列の行と列の変数と、ループ処理のカウンタ変数に代入する 2次元配列の次元を入れ替えることで、列の並び替えができるようになっています。

ただ、こちらの思い付きで改造したものであり、細かく検証したわけではないので、意図せぬ動作・結果が発生するかもしれません。

以下各 VBA コードの変更点について説明をします。

まずは列方向 - 昇順・降順クイックソート VBA プログラムのハイライトしてあるコード内容について。

16~18行目および 31行目の 2次元配列の最小・最大要素数を 2次元から 1次元に変更してます。

残りの各行にある引数として受け取った 2次元配列 argAry の行と列にある変数をすべて逆に入れ替えています。

以上の変更内容で並べ替えに必要な引数を受け取ることで、行方向から列方向への昇順・降順並び替えができることを確認しています。

Option Explicit

Sub QuickSortAscColumns(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long, ByVal keyPos As Long)
  ' クイックソート(昇順・列方向)(メモリリーク対策版)
  ' 参考サイト:2次元配列の並べ替え(バブルソート,クイックソート)https://excel-ubara.com/excelvba5/EXCELVBA229.html

  Dim i As Long, j As Long, k As Long
  Dim vBase As Variant, vSwap As Variant

  vBase = argAry(keyPos, Int((lngMin + lngMax) / 2))

  i = lngMin
  j = lngMax

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_argAry_1D As Variant, UB_argAry_1D As Variant
  LB_argAry_1D = LBound(argAry, 1)
  UB_argAry_1D = UBound(argAry, 1)

  Do
    Do While argAry(keyPos, i) < vBase ' 昇順
      i = i + 1
    Loop

    Do While argAry(keyPos, j) > vBase ' 昇順
      j = j - 1
    Loop

    If i >= j Then Exit Do

    For k = LB_argAry_1D To UB_argAry_1D
      vSwap = argAry(k, i)
      argAry(k, i) = argAry(k, j)
      argAry(k, j) = vSwap
    Next k

    i = i + 1
    j = j - 1
  Loop
  
  If (lngMin < i - 1) Then
    Call QuickSortAscColumns(argAry, lngMin, i - 1, keyPos)
  End If

  If (lngMax > j + 1) Then
    Call QuickSortAscColumns(argAry, j + 1, lngMax, keyPos)
  End If

End Sub
Option Explicit

Sub QuickSortAscColumns(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long, ByVal keyPos As Long)
  ' クイックソート(降順・列方向)(メモリリーク対策版)
  ' 参考サイト:2次元配列の並べ替え(バブルソート,クイックソート)https://excel-ubara.com/excelvba5/EXCELVBA229.html

  Dim i As Long, j As Long, k As Long
  Dim vBase As Variant, vSwap As Variant

  vBase = argAry(keyPos, Int((lngMin + lngMax) / 2))

  i = lngMin
  j = lngMax

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_argAry_1D As Variant, UB_argAry_1D As Variant
  LB_argAry_1D = LBound(argAry, 1)
  UB_argAry_1D = UBound(argAry, 1)

  Do
    Do While argAry(keyPos, i) > vBase ' 降順
      i = i + 1
    Loop

    Do While argAry(keyPos, j) < vBase ' 降順
      j = j - 1
    Loop

    If i >= j Then Exit Do

    For k = LB_argAry_1D To UB_argAry_1D
      vSwap = argAry(k, i)
      argAry(k, i) = argAry(k, j)
      argAry(k, j) = vSwap
    Next k

    i = i + 1
    j = j - 1
  Loop
  
  If (lngMin < i - 1) Then
    Call QuickSortAscColumns(argAry, lngMin, i - 1, keyPos)
  End If

  If (lngMax > j + 1) Then
    Call QuickSortAscColumns(argAry, j + 1, lngMax, keyPos)
  End If

End Sub

以下、列方向 - 昇順・降順クイックソート呼び出しプログラムのハイライトしてあるコード内容について。

34行目の Cells プロパティによるセル範囲の指定で、2行目から 1行目からに変更しています。これは列方向の並べ替えの場合、見出し部分も連動して並べ替えするためです。

48行目と51行目の Call ステートメントで呼び出すプロシージャの第 2引数と第 3引数を、2次元配列 arr1 の 1次元最小・最大要素番号を格納した変数から 2次元最小・最大要素番号を格納した変数に変更しています。

なお、第 4引数で指定してある数値はソートキーとなる 2次元配列の行番号であり、1 の場合は 1行目(ここでは見出し部分)を指していることになります。

62行目の指定したシートのセル範囲に転記する際の Range プロパティの開始セルを、34行目のセル範囲指定とあわせるため A2 セルから A1 セルに変更しています。

以上の変更内容でクイックソートプログラムに必要な引数を渡すことで、列方向への昇順・降順で並び替えたデータを受け取ることができます。

Option Explicit

Sub QuickSortSingleKeyColumnsFixMemoryLeaks() ' メモリリーク対策版
  ' シート「都道府県県庁所在地地方区分ランダム並べ替え」内容をシート上で並べ替えずに、2次元配列を使ってクイックソートで列方向並べ替え

  ' 実行速度計測開始
  Dim starttime As Double
  starttime = Timer

' ----------

  ' 変数宣言
  Dim i As Long, k As Long ' カウンタ用変数(一見見分けにくい文字同士を組み合わせない形、i と j、m と n、o(オー) と 0(ゼロ))

' ----------

  ' 変数宣言
  Dim ws1 As Worksheet ' シート格納用オブジェクト変数

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え") ' ソート元シートをオブジェクト変数にセット

  Dim maxrow1 As Long ' 最終行取得用変数
  Dim maxcol1 As Long ' 最終列取得用変数

  ' シートの最終行・最終列を取得して変数に格納
  maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).row
  maxcol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

  ' 変数宣言
  Dim arr1() As Variant ' ソート対象データ格納用動的配列

  ' シートの指定した範囲内セルを配列としてバリアント型動的配列に格納
  arr1 = ws1.Range(ws1.Cells(1, 1), ws1.Cells(maxrow1, maxcol1)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  arr1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_arr1_1D As Variant, UB_arr1_1D As Variant
  Dim LB_arr1_2D As Variant, UB_arr1_2D As Variant
  LB_arr1_1D = LBound(arr1, 1)
  UB_arr1_1D = UBound(arr1, 1)
  LB_arr1_2D = LBound(arr1, 2)
  UB_arr1_2D = UBound(arr1, 2)

  ' クイックソート(昇順・列方向)
  Call QuickSortAscColumns.QuickSortAscColumns(arr1, LB_arr1_2D, UB_arr1_2D, 1)

  ' クイックソート(降順・列方向)
'  Call QuickSortDescColumns.QuickSortAscColumns(arr1, LB_arr1_2D, UB_arr1_2D, 1)

' ----------

  ' 変数宣言
  Dim ws2 As Worksheet ' シート格納用オブジェクト変数

  ' オブジェクト変数にシートセット
  Set ws2 = ThisWorkbook.Worksheets("クイックソート") ' 転記先シートをオブジェクト変数にセット

  ' 二次元配列 data2 の内容を、貼り付け先シートの Range で指定したセルから Resize で範囲を変更してセルに代入
  ws2.Range("A1").Resize(UB_arr1_1D, UB_arr1_2D) = arr1
  ws2.Activate

' ----------

  ' 実行速度計測結果表示
  Debug.Print Format(Timer - starttime, "0.00秒")

End Sub

その他、既存のクイックソートプログラムを使って列方向を昇順・降順にソートするには次の手順が考えられます。

ソート対象のデータを Transpose 関数か For 文による 2次元配列のループ処理で、2次元配列の 1次元と 2次元の各要素を入れ替え ます。

1次元と 2次元の各要素を入れ替えた 2次元配列に対してクイックソートプログラムを実行してソートします。

ソート後、再度 Transpose 関数か For 文で、2次元配列の 1次元と 2次元の各要素を入れ替え て戻すことでソート完了となります。

ただし、Transpose 関数を使う場合は要素数が 65536 を超えるとエラーになるようなので、その場合は For 文を使った 2次元配列の 1次元と 2次元の各要素を入れ替えるプログラムを使うことになります。