■非再帰QuickSort（反省編

>結果。やっぱ再帰のほうが記述が簡単で速い。
ぃゃ、私が書くと..って事なのだが。
>#ぃゃもっと効率良く書けるのかもしれないが..力ないです..orz
とは言うものの、少し足掻いてみた。

>A列に6桁ランダム数値を全角文字列にしたデータでテスト。重複あり。

Option Explicit

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private QS() As String　　　　'ソートデータ用
Private QL() As Long　　　　　'ソートインデックス用
'-------------------------------------------------
Private Sub test()　　　　　　'テストプロシージャ選択用
　　Const cnt As Long = 65536 'テストデータ量
　　Dim ret() As String　　　 '書出し用配列
　　Dim t(1)　As Long
　　Dim i　　 As Long
　　Dim v

　　ReDim QS(1 To cnt)
　　ReDim QL(1 To cnt)
　　ReDim ret(1 To cnt, 0)

　　For Each v In Range("A1").Resize(cnt).Value
　　　　i = i + 1
　　　　QL(i) = i
　　　　QS(i) = v
　　Next

　　t(0) = timeGetTime

　　Call LQuickLoop3

　　For i = 1 To cnt
　　　　ret(i, 0) = QS(QL(i))
　　Next

　　t(1) = timeGetTime

　　'Sheets.Add.Range("A1").Resize(cnt).Value = ret
　　Erase QS, QL, ret
　　Debug.Print cnt, t(1) - t(0)
End Sub
'-------------------------------------------------
Private Sub LQuickLoop3()　　 '非再帰
　　Const p　　 As Long = 100 '記憶用配列サイズ
　　Dim flg0(p) As Boolean　　'Lo処理記憶用
　　Dim flg1(p) As Boolean　　'Up処理記憶用
　　Dim idxi(p) As Long　　　 'Index記憶用
　　Dim idxj(p) As Long　　　 'Index記憶用
　　Dim jj(p)　 As Long　　　 'Loopカウンタ記憶用
　　Dim Lv　　　As Long　　　 '深さレベル
　　Dim i　　　 As Long
　　Dim j　　　 As Long
　　Dim k　　　 As Long
　　Dim tmp　　 As String

　　Lv = 1
　　idxi(Lv) = LBound(QL)
　　idxj(Lv) = UBound(QL)

　　Do While Lv > 0

　　　　Do
　　　　　　If flg0(Lv) Then Exit Do
　　　　　　flg0(Lv) = True
　　　　　　i = idxi(Lv)
　　　　　　j = idxj(Lv)
　　　　　　tmp = QS(QL((i + j) ¥ 2))

　　　　　　Do
　　　　　　　　Do While tmp > QS(QL(i))
　　　　　　　　　　i = i + 1
　　　　　　　　Loop
　　　　　　　　Do While tmp < QS(QL(j))
　　　　　　　　　　j = j - 1
　　　　　　　　Loop
　　　　　　　　If i >= j Then
　　　　　　　　　　Exit Do
　　　　　　　　End If
　　　　　　　　k = QL(i)
　　　　　　　　QL(i) = QL(j)
　　　　　　　　QL(j) = k
　　　　　　　　i = i + 1
　　　　　　　　j = j - 1
　　　　　　Loop

　　　　　　jj(Lv) = j
　　　　　　If (i - 1) <= idxi(Lv) Then
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　Lv = Lv + 1
　　　　　　idxi(Lv) = idxi(Lv - 1)
　　　　　　idxj(Lv) = i - 1
　　　　　　flg0(Lv) = False
　　　　　　flg1(Lv) = False
　　　　Loop

　　　　If Not flg1(Lv) Then
　　　　　　flg1(Lv) = True
　　　　　　If (jj(Lv) + 1) < idxj(Lv) Then
　　　　　　　　Lv = Lv + 1
　　　　　　　　idxi(Lv) = jj(Lv - 1) + 1
　　　　　　　　idxj(Lv) = idxj(Lv - 1)
　　　　　　　　flg0(Lv) = False
　　　　　　　　flg1(Lv) = False
　　　　　　Else
　　　　　　　　Do
　　　　　　　　　　Lv = Lv - 1
　　　　　　　　Loop While flg1(Lv)
　　　　　　End If
　　　　End If

　　Loop
End Sub

ちょっとは見通し良くなったけど..ジリキではここが限界？
再帰版の処理順をトレースして作るとこんな感じからどうも抜け出せない...

..っというわけでカンニング編に続く..（ぇ