| 
    
     |  | ↑のコードでは Dirで検索に引っかかった順番でフォルダごとのファイル リストが出力されるだけなので、シートに一覧を吐き出してから、
 サブフォルダごとにファイルを並び替える処理を追加してみました。
 
 Sub さくら3()
 '(宣言部 省略)
 
 FileSearch LookIn, Filename, FoundFiles(), nCount, mCount, 0
 
 If (nCount - mCount) > 0 Then
 Dim r As Range, c As Range
 With Worksheets
 With .Add(After:=.Item(.Count))
 Set r = .[A1].Resize(nCount, 2)
 r.Value = Trans(FoundFiles())
 Application.ScreenUpdating = 0
 On Error Resume Next
 For Each c In r.Columns(2). _
 Cells.SpecialCells(xlConstants).Areas
 .Sort Key1:=c.Item(1), Header:=xlNo
 Next
 On Error GoTo 0
 Application.ScreenUpdating = 1
 End With
 End With
 MsgBox nCount - mCount & "個のファイルがマッチしました"
 End If
 End Sub
 
 |  |