VBAで出力するファイルを昇順で並べ替えしたい


あるディレクトリに配置されたファイルを、Excelのセルに入力した文字列をもとにピックアップして結合させるマクロを作成しています。結合させるものは完成したのですが、これを昇順でソートさせる方法がわかりません、、、


どなたか改変する形で、どうすれば良いか教えて頂けないでしょうか、、、


あくまで、作成したコードに手を加える形でのご教示をお願い致しますm(__)m

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2013/05/30 00:21:21
  • 終了:2013/05/30 17:57:05
id:tobias1208

作成したマクロのコードは下記です。


Option Explicit

'-----ファイル処理-----'
Sub appendFile(path As String, fname As String, outfname As String)
Dim buf As String, idx As String
Dim fname2 As String, fname3 As String
Dim x As Long

'-----CSVファイルの読み込みと書き込みを実行-----'
fname2 = path & fname
Open fname2 For Input As #1
Open outfname For Append As #2
Do Until EOF(1)
Line Input #1, buf
Print #2, buf
Loop
Close #2
Close #1

End Sub

'-----Sub mainにあるhogeCouplingからディレクトリ、ファイル形式、出力形式を呼び出し-----'
Sub hogeCoupling(path As String, ext As String, outfname As String)
Dim fcol As Object, re As Object
Dim flist As Variant, remat As Variant
Dim pat As String, fname As String
Dim n As Long

'-----処理対象ファイル探索と処理の実行-----'
Set fcol = CreateObject("Scripting.FileSystemObject").GetFolder(path).Files
Set re = CreateObject("VBScript.RegExp")
pat = "^" & Cells(11, 4) '入力した2つのセルを組み合わせた形式のファイルを定義
With re
.Pattern = pat
.IgnoreCase = True
.Global = True
For Each flist In fcol
Set remat = .Execute(flist.Name)
If remat.Count > 0 Then
Call appendFile(path, flist.Name, outfname)
End If
Next flist
End With
Set re = Nothing
Set fcol = Nothing
End Sub

Sub main()
Call hogeCoupling("C:/test/Log/", "csv", "C:/test/出力結果/" & Cells(11, 4) & "_Summarize.csv")

MsgBox "作成完了しました、ファイルを確認してください"

End Sub

ベストアンサー

id:Silvanus No.1

Silvanus回答回数174ベストアンサー獲得回数672013/05/30 12:21:42

これで行けると思うのですが、いかがでしょうか。
既存コードのSub main()中にある"Call hogeCoupling(..."の次行に

SortByTime "C:/test/出力結果/" & Cells(11, 4) & "_Summarize.csv" 

を記入した後に下記のサブルーティンをどこかに追加して下さい。

Sub SortByTime(ByVal strCSVFile as string)
    
    Dim rngLstCll As Range
    
    Workbooks.Open Filename:=strCSVFile
    Set rngLstCll = Cells.SpecialCells(xlCellTypeLastCell)
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(Cells(1, 1), Cells(rngLstCll.Row, 1)), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range(Cells(1, 1), rngLstCll)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    Set rngLstCll = Nothing
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True

End Sub

その他の回答(0件)

id:Silvanus No.1

Silvanus回答回数174ベストアンサー獲得回数672013/05/30 12:21:42ここでベストアンサー

これで行けると思うのですが、いかがでしょうか。
既存コードのSub main()中にある"Call hogeCoupling(..."の次行に

SortByTime "C:/test/出力結果/" & Cells(11, 4) & "_Summarize.csv" 

を記入した後に下記のサブルーティンをどこかに追加して下さい。

Sub SortByTime(ByVal strCSVFile as string)
    
    Dim rngLstCll As Range
    
    Workbooks.Open Filename:=strCSVFile
    Set rngLstCll = Cells.SpecialCells(xlCellTypeLastCell)
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(Cells(1, 1), Cells(rngLstCll.Row, 1)), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range(Cells(1, 1), rngLstCll)
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    Set rngLstCll = Nothing
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True

End Sub
  • id:Silvanus
    ソートの基準となるのは、ファイル名なのか、それとも
    ファイルの内容(各行?)なのかで、全くコードが変わってきますが
    どうなのでしょうか?
    もしファイル内容に基づくのであれば、ファイル内容のサンプルの提示か
    あるいはソートキーに関する説明が無いと、回答できないと思います。
  • id:taknt
    ソートする対象を 配列に取り込んで、クイックソート
  • id:tobias1208
    Silvanusさん

    すみません!A列に時刻が記載してあり、これをキーに昇順に並べ替えしたいのですm(__)m

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません