![](https://sibainu.lsv.jp/wp-content/uploads/2022/05/DSC_0171-739x1024.jpg)
VBAでクイックソートコードを作成
VBAには、配列の演算子がありません。Python、Rなど配列の演算がとても楽にきれいなコードでできますが、VBAにはないので自分でゴリゴリとやります。
ソートしたい配列の中央値を基準として、小さい値、大きい値を新たに2つ配列をつくりそれぞれ振り分けてセットしていきます。振り分けて作った配列を再帰して同じことを繰り返します。
![](https://www.sibainu.org/wordpress/wp-content/uploads/2022/05/EXCEL.jpg)
エクセルのA列に、ソートしたいデータを作りC列にソートした結果を表示しています。10,000件あまりをソートしてみましたところ、一瞬にできました。
530,0000件、600,000件で試してみました。スッタク領域不足のエラーになりました。520,000件は35秒で無事ソートできました。
520,000<2の17乗=524,288<530,000
17層の再帰までは良さそうです。
EXCELのVBAコード
Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim BUF As Variant Dim PickUP() As String Dim RES As Variant Dim PasteArray() As String Dim I As Long Dim EndRow As Long With ActiveSheet EndRow = .Cells(.Rows.Count, 1).End(xlUp).Row BUF = .Range(.Cells(1, 1), .Cells(EndRow, 1)).Value End With ReDim PickUP(UBound(BUF, 1)) For I = 1 To UBound(PickUP) PickUP(I) = BUF(I, 1) Next I PickUP(0) = UBound(PickUP) RES = Quick(PickUP) ReDim PasteArray(1 To UBound(RES), 1 To 1) For I = 1 To UBound(RES) PasteArray(I, 1) = RES(I) Next I Range(Cells(1, 3), Cells(UBound(PasteArray, 1), 3)) = PasteArray End Sub
ソートの再帰コードです。
Private Function Quick(ByRef Target As Variant) As Variant Dim Pivot As String Dim Leftlist() As String Dim LCount As Long Dim RightList() As String Dim RCount As Long Dim RBuf As Variant Dim lBuf As Variant Dim RES() As String Dim I As Long Dim Posi As Long If Target(0) < 2 Then '再帰の終了条件です。 '再帰させずそのまま返します。 Quick = Target Else '軸を中央にします。 Posi = Target(0) / 2 '比較する基準値 Pivot = Target(Posi) '基準値より小さい値(<)を格納する配列 ReDim Leftlist(Target(0)) '基準値より大きい値(>=)を格納する配列 ReDim RightList(Target(0)) '格納するインデックス LCount = 0 RCount = 0 For I = 1 To Target(0) If I <> Posi Then If Pivot < Target(I) Then RCount = RCount + 1 RightList(RCount) = Target(I) Else LCount = LCount + 1 Leftlist(LCount) = Target(I) End If End If Next I '配列のトップに値の数をセットします。 RightList(0) = RCount Leftlist(0) = LCount '余分なインデックスを削除します。 ReDim Preserve RightList(RCount) ReDim Preserve Leftlist(LCount) '作られた配列を再帰します。 RBuf = Quick(RightList) lBuf = Quick(Leftlist) '返された配列を結合して返します。 ReDim RES(LCount + 1 + RCount) For I = 1 To LCount RES(I) = lBuf(I) Next I RES(LCount + 1) = Pivot For I = 1 To RCount RES(LCount + 1 + I) = RBuf(I) Next I Quick = RES End If End Function