「VBA覚書」クイックソート

ソートのアルゴリズムは

・バブルソート
・バケットソート（ビンソート）
・基数ソート
・ヒープソート
・マージソート（併合ソート）
・クイックソート
・EXCELのソート

とまぁ色々ありますが、

使い勝手が一番良いのは『クイックソート』だと思ってます。

他は、いずれ・・・・？




「サンプルコード」

Option Explicit
'***********************************************************************************
' 関数名　　　　　:qSort
' 機能　　　　　　:一次元配列をソートする
' 引数　　　　　　:配列(I/O)、開始行、終了行
'***********************************************************************************
''========================================================
Public Sub procSort1()

Dim aryDat As Variant
Dim varDat As Variant

''ソートする配列を設定
aryDat = Array("D", "E", "F", "A", "B", "C")

Debug.Print "ソート実行前"
For Each varDat In aryDat
Debug.Print varDat
Next

''一次元配列ソートを実行
Call qSort(aryDat, LBound(aryDat), UBound(aryDat))

Debug.Print "ソート実行後"
For Each varDat In aryDat
Debug.Print varDat
Next

End Sub
''========================================================

Public Sub qSort(ByRef argAry As Variant, ByVal L As Long, ByVal U As Long)
Dim i As Long, j As Long
Dim S As Variant, T As Variant

S = argAry(Int((L + U) / 2))
i = L
j = U

Do
Do While argAry(i) < S: i = i + 1: Loop
Do While argAry(j) > S: j = j - 1: Loop
If i >= j Then Exit Do
T = argAry(i)
argAry(i) = argAry(j)
argAry(j) = T
i = i + 1
j = j - 1
Loop

If (L < i - 1) Then qSort argAry, L, i - 1
If (U > j + 1) Then qSort argAry, j + 1, U

End Sub

「実行結果」========================================================
ソート実行前
D
E
F
A
B
C
ソート実行後
A
B
C
D
E
F




'***********************************************************************************
' 関数名　　　　　:qSort2
' 機能　　　　　　:二次元配列をソートする
' 引数　　　　　　:配列(I/O)、開始行、終了行、カラム位置
'***********************************************************************************
''========================================================
Public Sub procSort2()

Dim aryDat As Variant
Dim iAry As Integer

''ソートする配列を設定
ReDim aryDat(5, 1) As Variant
aryDat(0, 0) = "D"
aryDat(1, 0) = "E"
aryDat(2, 0) = "F"
aryDat(3, 0) = "A"
aryDat(4, 0) = "B"
aryDat(5, 0) = "C"

aryDat(0, 1) = "あいうえお"
aryDat(1, 1) = "かきくけこ"
aryDat(2, 1) = "さしすせそ"
aryDat(3, 1) = "たちつてと"
aryDat(4, 1) = "なにぬねの"
aryDat(5, 1) = "はひふへほ"

Debug.Print "ソート実行前"
For iAry = 0 To UBound(aryDat, 1)
Debug.Print aryDat(iAry, 0) & " : " & aryDat(iAry, 1)
Next

''カラム１をキーにして二次元配列ソートを実行
Call qSort2(aryDat, LBound(aryDat), UBound(aryDat), 0)

Debug.Print "ソート実行後"
For iAry = 0 To UBound(aryDat, 1)
Debug.Print aryDat(iAry, 0) & " : " & aryDat(iAry, 1)
Next

''カラム２をキーにして二次元配列ソートを実行
Call qSort2(aryDat, LBound(aryDat), UBound(aryDat), 1)

Debug.Print "ソート実行後"
For iAry = 0 To UBound(aryDat, 1)
Debug.Print aryDat(iAry, 0) & " : " & aryDat(iAry, 1)
Next

End Sub
''========================================================

Public Sub qSort2(ByRef argAry As Variant, ByVal L As Long, ByVal U As Long, ByVal P As Long)
Dim i As Long, j As Long, k As Long
Dim S As Variant, T As Variant

S = argAry(Int((L + U) / 2), P)
i = L
j = U
Do
Do While argAry(i, P) < S: i = i + 1: Loop
Do While argAry(j, P) > S: j = j - 1: Loop
If i >= j Then Exit Do
For k = LBound(argAry, 2) To UBound(argAry, 2)
T = argAry(i, k)
argAry(i, k) = argAry(j, k)
argAry(j, k) = T
Next
i = i + 1
j = j - 1
Loop

If (L < i - 1) Then Call qSort2(argAry, L, i - 1, P)
If (U > j + 1) Then Call qSort2(argAry, j + 1, U, P)

End Sub

「実行結果」========================================================
ソート実行前
D : あいうえお
E : かきくけこ
F : さしすせそ
A : たちつてと
B : なにぬねの
C : はひふへほ

カラム１をキーにした二次元配列ソートの実行結果
A : たちつてと
B : なにぬねの
C : はひふへほ
D : あいうえお
E : かきくけこ
F : さしすせそ

カラム２をキーにした二次元配列ソートの実行結果
D : あいうえお
E : かきくけこ
F : さしすせそ
A : たちつてと
B : なにぬねの
C : はひふへほ

-----[PR]-----

-----------【PR】-------------

タグ：ビジュアルベーシック Visual Basic Vb Microsoft VBA エクセル 覚書 Excel プログラム Office オフィス

コメント 1

信じられないほどのポイント。強固な議論。偉大な精神を維持してください。
by Winifred (2018-01-21 01:02)