■非再帰QuickSort（カンニング編

と、いう事でここは先人の経験と技術を素直に学ばせていただこう。
#決してカンニングではない..と思う（多分 X)

残念ながら出典サイトはなくなってしまいました。
確か「Excel VBA 実用サンプルコレクション」著者 渡辺ひかる氏のサイト（www.vbasekai.com）に、
以前mougでよく回答してらっしゃった工藤氏のコードが載ってたと思う。
それを参考にさせて頂きました。感謝。

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 p　　 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

　　p = 1
　　t(0) = timeGetTime
　　Select Case p
　　Case 1
　　　　Call LQuickSort(1, cnt)
　　Case 2
　　　　Call LQuickSortS(1, cnt)
　　Case 3
　　　　Call LQuickLoop4
　　End Select

　　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 LQuickSort(n As Long, x As Long) '再帰
　　Dim tmp As String
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim k　 As Long

　　i = n
　　j = x
　　tmp = QS(QL((i + j) ¥ 2))

　　Do
　　　　Do While QS(QL(i)) < tmp
　　　　　　i = i + 1
　　　　Loop
　　　　Do While tmp < QS(QL(j))
　　　　　　j = j - 1
　　　　Loop

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

　　If n < (i - 1) Then
　　　　LQuickSort n, i - 1
　　End If
　　If (j + 1) < x Then
　　　　LQuickSort j + 1, x
　　End If
End Sub
'-------------------------------------------------
Private Sub LQuickSortS(n As Long, x As Long) '再帰
　　Dim tmp As String
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim k　 As Long

　　tmp = QS(QL((n + x) ¥ 2))
　　i = n - 1
　　j = x + 1

　　Do
　　　　Do
　　　　　　i = i + 1
　　　　Loop While QS(QL(i)) < tmp
　　　　Do
　　　　　　j = j - 1
　　　　Loop While tmp < QS(QL(j))

　　　　If j <= i Then
　　　　　　Exit Do
　　　　End If
　　　　k = QL(i)
　　　　QL(i) = QL(j)
　　　　QL(j) = k
　　Loop

　　If n < (i - 1) Then
　　　　LQuickSortS n, i - 1
　　End If
　　If (j + 1) < x Then
　　　　LQuickSortS j + 1, x
　　End If
End Sub
'-------------------------------------------------
Private Sub LQuickLoop4()　　 '非再帰
　　Const p　　 As Long = 100 '記憶用配列サイズ
　　Dim idxi(p) As Long　　　 'Index記憶用
　　Dim idxj(p) As Long　　　 'Index記憶用
　　Dim Lv　　　As Long　　　 '深さレベル
　　Dim mn　　　As Long
　　Dim mx　　　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
　　　　mn = idxi(Lv)
　　　　mx = idxj(Lv)
　　　　Lv = Lv - 1
　　　　tmp = QS(QL((mn + mx) ¥ 2))
　　　　i = mn - 1
　　　　j = mx + 1

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

　　　　If mn < (i - 1) Then
　　　　　　Lv = Lv + 1
　　　　　　idxi(Lv) = mn
　　　　　　idxj(Lv) = i - 1
　　　　End If
　　　　If (j + 1) < mx Then
　　　　　　Lv = Lv + 1
　　　　　　idxi(Lv) = j + 1
　　　　　　idxj(Lv) = mx
　　　　End If
　　Loop
End Sub

[LQuickSort]
65536　　　　 329
65536　　　　 329
65536　　　　 328

[LQuickSortS]
65536　　　　 312
65536　　　　 297
65536　　　　 297

[LQuickLoop4]
65536　　　　 312
65536　　　　 297
65536　　　　 314

ver2010。
[LQuickSort]
1000000　　　 6907
1000000　　　 7032
1000000　　　 7017

[LQuickSortS]
1000000　　　 6766
1000000　　　 6800
1000000　　　 6781

[LQuickLoop4]
1000000　　　 6719
1000000　　　 6767
1000000　　　 6735

再帰版と同等の速さです。しかも簡潔。
達人の方が書くとこうも違うものなのですね..
他にも色々なサイトで非再帰版のコードを見て勉強させて頂きましたが、
[LQuickLoop4]の元になった工藤氏のコードが一番勉強になりました。有難うございます。

また、再帰版も再掲してますが、[LQuickSortS]は今回Loop版に合わせて比較の意味で載せました。
以前はこっち使ってたんですが、いつの間にか変わってました。[LQuickSort]のコードの方が馴染みやすいのかな..
#師匠の教えもあってちょっと修正してますが :)
それにしても、ちょっとしたコーディングの違いで差が出るもんなんですね－

あとは余談。
コードを見てもらうとわかる事なので今さらですが、今回の配列ソートは配列そのものを入れ替えずに
ソートインデックス用のLong型配列を作ってこれを入れ替えてます。
これは、セル範囲を配列に取得したVariant型２次元配列をそのままQuickSortする場合と比較して、
ソートデータ用のString型１次元配列、ソートインデックス用Long型１次元配列、
それに書出し用２次元配列にLoop処理で格納し直す処理を入れても、より高速に処理できます。

■非再帰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

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

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

■QuickSort再帰|非再帰

QuickSort非再帰を試してみる。
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 i　　 As Long
　　Dim p　　 As Long
　　Dim t　　 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

　　p = 1 '0 or 1

　　t = timeGetTime

　　Select Case p
　　Case 0
　　　　Call LQuickSort(1, cnt)
　　Case 1
　　　　Call LQuickLoop
　　End Select

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

　　Debug.Print cnt, timeGetTime - t
　　'Sheets.Add.Range("A1").Resize(cnt).Value = ret
　　Erase QS, QL, ret
End Sub
'-------------------------------------------------
Sub LQuickSort(n As Long, x As Long) '再帰
　　Dim tmp As String
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim k　 As Long

　　i = n
　　j = x
　　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

　　If n < (i - 1) Then
　　　　LQuickSort n, i - 1
　　End If
　　If x > (j + 1) Then
　　　　LQuickSort j + 1, x
　　End If
End Sub
'-------------------------------------------------
Sub LQuickLoop()　　　　　　'非再帰
　　Const p　 As Long = 100 '記憶用配列サイズ・漸増用兼
　　Dim tmp　 As String
　　Dim flg() As Boolean　　'Lo|Up処理記憶用
　　Dim ix()　As Long　　　 'Index記憶用
　　Dim ii()　As Long　　　 'Loopカウンタ記憶用
　　Dim jj()　As Long　　　 'Loopカウンタ記憶用
　　Dim Lv　　As Long　　　 '深さレベル
　　Dim Mx　　As Long　　　 '配列漸増用（今回未使用）
　　Dim i　　 As Long
　　Dim j　　 As Long
　　Dim k　　 As Long

　　ReDim flg(1, p)
　　ReDim ix(1, p)
　　ReDim ii(p)
　　ReDim jj(p)

　　Mx = p
　　Lv = 1
　　ix(0, Lv) = LBound(QL)
　　ix(1, Lv) = UBound(QL)

　　Do

　　　　Do
　　　　　　If flg(1, Lv) Then
　　　　　　　　Lv = Lv - 1
　　　　　　　　Exit Do
　　　　　　End If

　　　　　　Do
　　　　　　　　If flg(0, Lv) Then
　　　　　　　　　　Exit Do
　　　　　　　　End If

　　　　　　　　i = ix(0, Lv)
　　　　　　　　j = ix(1, 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

　　　　　　　　flg(0, Lv) = True
　　　　　　　　ii(Lv) = i
　　　　　　　　jj(Lv) = j

　　　　　　　　If ix(0, Lv) >= (i - 1) Then
　　　　　　　　　　Exit Do
　　　　　　　　End If

　　　　　　　　Lv = Lv + 1
　　　　　　　　ix(0, Lv) = ix(0, Lv - 1)
　　　　　　　　ix(1, Lv) = i - 1
　　　　　　　　flg(0, Lv) = False
　　　　　　　　flg(1, Lv) = False
　　　　　　Loop

　　　　　　flg(1, Lv) = True

　　　　　　If ix(1, Lv) <= (jj(Lv) + 1) Then
　　　　　　　　Lv = Lv - 1
　　　　　　　　Exit Do
　　　　　　End If

　　　　　　Lv = Lv + 1
　　　　　　ix(0, Lv) = jj(Lv - 1) + 1
　　　　　　ix(1, Lv) = ix(1, Lv - 1)
　　　　　　flg(0, Lv) = False
　　　　　　flg(1, Lv) = False
　　　　Loop
　　Loop Until Lv < 1
End Sub

結果。やっぱ再帰のほうが記述が簡単で速い。
#ぃゃもっと効率良く書けるのかもしれないが..力ないです..orz

[LQuickSort]
65536　　　　 328
65536　　　　 329
65536　　　　 328

[LQuickLoop]
65536　　　　 360
65536　　　　 344
65536　　　　 344

一応2010でも試してみた。
[LQuickSort]
1000000　　　 6783
1000000　　　 7188
1000000　　　 7204

[LQuickLoop]
1000000　　　 7610
1000000　　　 7719
1000000　　　 7703

■Dir再帰|非再帰

対象フォルダ配下サブフォルダ含めてファイルリストを取得したい、というニーズであまり使われないDir関数。
不具合あるからね。でもあまのじゃっきーだから一応書いてみる。

Option Explicit

Private Const cPath As String = "C:¥WORK¥" '対象フォルダパス
Private Const MX　　As Long = 100000　　　 '取得用配列サイズ大きめに
Private fList()　　 As String　　　　　　　'ファイル名取得用配列
Private idx　　　　 As Long　　　　　　　　'配列Index
'-------------------------------------------------
Private Sub test() 'テストプロシージャ選択用
　　Dim t As Single
　　t = Timer

　　Call TestDirRecur

　　Debug.Print idx & " files", Timer - t
End Sub
'-------------------------------------------------
Private Sub TestDirRecur() '再帰版
　　Dim sPath As String
　　ReDim fList(1 To MX, 0)

　　sPath = cPath
　　idx = 0
　　Call DirRecur(sPath)
　　'Sheets.Add.Range("A1").Resize(idx).Value = fList
　　Erase fList
End Sub
Private Sub DirRecur(sPath As String)
　　Dim sList(1 To 1000) As String
　　Dim fPath As String
　　Dim ret　 As String
　　Dim si　　As Long
　　Dim i　　 As Long

　　On Error GoTo ErrH:
　　ret = Dir(sPath, vbDirectory Or vbReadOnly _
　　　　　　　　　　 Or vbHidden Or vbSystem)
　　Do Until Len(ret) = 0
　　　　If ret <> "." And ret <> ".." Then
　　　　　　idx = idx + 1
　　　　　　fPath = sPath & ret
　　　　　　fList(idx, 0) = fPath
　　　　　　If GetAttr(fPath) And vbDirectory Then
　　　　　　　　si = si + 1
　　　　　　　　sList(si) = fPath & "¥"
　　　　　　End If
　　　　End If
　　　　ret = Dir()
　　Loop

　　For i = 1 To si
　　　　Call DirRecur(sList(i))
　　Next

　　Exit Sub

ErrH:
　　'Debug.Print fPath
　　'Debug.Print Err.Number, Err.Description
　　Resume Next
End Sub
'-------------------------------------------------
Private Sub TestDirLoop()　'非再帰版
　　Dim sPath As String
　　Dim fPath As String
　　Dim ret　 As String
　　Dim i　　 As Long
　　Dim j　　 As Long
　　Dim d(1 To MX) As Long 'サブフォルダidx記憶用
　　ReDim fList(1 To MX, 0)

　　On Error GoTo ErrH:
　　sPath = cPath
　　idx = 0
　　Do
　　　　ret = Dir(sPath, vbDirectory Or vbReadOnly _
　　　　　　　　　　　　 Or vbHidden Or vbSystem)
　　　　Do Until Len(ret) = 0
　　　　　　If ret <> "." And ret <> ".." Then
　　　　　　　　idx = idx + 1
　　　　　　　　fPath = sPath & ret
　　　　　　　　fList(idx, 0) = fPath
　　　　　　　　If GetAttr(fPath) And vbDirectory Then
　　　　　　　　　　i = i + 1
　　　　　　　　　　d(i) = idx
　　　　　　　　End If
　　　　　　End If
　　　　　　ret = Dir()
　　　　Loop

　　　　j = j + 1
　　　　If j > i Then Exit Do
　　　　sPath = fList(d(j), 0) & "¥"
　　Loop

　　'Sheets.Add.Range("A1").Resize(idx).Value = fList
　　Erase fList

　　Exit Sub

ErrH:
　　'Debug.Print fPath
　　'Debug.Print Err.Number, Err.Description
　　Resume Next
End Sub

結果。Unicode文字あるとGetAttr関数のところでエラーになるし、256Byteあたりの制限ありますよね..
なので実用的ではないけど..一応。

[TestDirRecur]
20000 files　　1.375
20000 files　　1.359375
20000 files　　1.359375

[TestDirLoop]
20000 files　　1.390625
20000 files　　1.359375
20000 files　　1.34375

C:\WORK配下のフォルダは最大10階層。
20,000ファイル＆フォルダでのテスト。
#つまり昨日と一緒.. :)

■Fso再帰|非再帰

#しばらくscrapネタ続きます.. :)

対象フォルダ配下サブフォルダ含めてファイルリストを取得したい、というニーズでよく使われるFileSystemObject再帰。
あまのじゃっきーな私はこの非再帰コードを書いてみた。

Option Explicit

Private Const cPath As String = "C:¥WORK¥" '対象フォルダパス
Private Const MX　　As Long = 100000　　　 '取得用配列サイズ大きめに
Private FSO　　　　 As Object　　　　　　　'FileSystemObject
Private fList()　　 As String　　　　　　　'ファイル名取得用配列
Private idx　　　　 As Long　　　　　　　　'配列Index
'-------------------------------------------------
Private Sub test() 'テストプロシージャ選択用
　　Dim t As Single
　　t = Timer

　　Call TestFsoLoop

　　Debug.Print idx & " files", Timer - t
End Sub
'-------------------------------------------------
Private Sub TestFsoRecur() '再帰版
　　Dim sPath As String
　　ReDim fList(1 To MX, 0)

　　sPath = cPath
　　idx = 0
　　Set FSO = CreateObject("scripting.filesystemobject")
　　Call FsoRecur(sPath)
　　Set FSO = Nothing
　　'Sheets.Add.Range("A1").Resize(idx).Value = fList
　　Erase fList
End Sub
Private Sub FsoRecur(sPath As String)
　　Dim x As Object

　　With FSO.GetFolder(sPath)
　　　　For Each x In .Files
　　　　　　idx = idx + 1
　　　　　　fList(idx, 0) = x.Path
　　　　Next
　　　　For Each x In .SubFolders
　　　　　　idx = idx + 1
　　　　　　fList(idx, 0) = x.Path
　　　　　　Call FsoRecur(x.Path)
　　　　Next
　　End With
End Sub
'-------------------------------------------------
Private Sub TestFsoLoop()　'非再帰版
　　Dim x　　 As Object
　　Dim sPath As String
　　Dim i　　 As Long
　　Dim j　　 As Long
　　Dim d(1 To MX) As Long 'サブフォルダidx記憶用
　　ReDim fList(1 To MX, 0)

　　sPath = cPath
　　idx = 0
　　Set FSO = CreateObject("scripting.filesystemobject")
　　Do
　　　　With FSO.GetFolder(sPath)
　　　　　　For Each x In .SubFolders
　　　　　　　　idx = idx + 1
　　　　　　　　i = i + 1
　　　　　　　　fList(idx, 0) = x.Path
　　　　　　　　d(i) = idx
　　　　　　Next
　　　　　　For Each x In .Files
　　　　　　　　idx = idx + 1
　　　　　　　　fList(idx, 0) = x.Path
　　　　　　Next
　　　　End With
　　　　j = j + 1
　　　　If j > i Then Exit Do
　　　　sPath = fList(d(j), 0)
　　Loop
　　Set FSO = Nothing
　　'Sheets.Add.Range("A1").Resize(idx).Value = fList
　　Erase fList
End Sub

結果。別に速さを求めたわけじゃないけど..一応。

[TestFsoRecur]
20000 files　　15.70313
20000 files　　15.71875
20000 files　　15.71875

[TestFsoLoop]
20000 files　　15.03125
20000 files　　15.03125
20000 files　　15.03125

C:\WORK配下のフォルダは最大10階層。
20,000ファイル＆フォルダでのテスト。