大量（多数）のCSVファイルの処理を高速化

投稿者 : アンカー     投稿日時 : 2021/04/26(Mon) 17:00:06     OS : Windows 10     EXCEL : Excel 2016

---

大量（多数）のCSVファイルの処理を高速化したく、質問致します。

・CSV 1ファイルは1500行30列（460KB）、365ファイル/年、24年分（合計8700ファイル）あります。
・1ファイルずつクエリテーブルで読み込み、マクロブックTHISwbの"Day"シートに出力します。（コード①の部分）
・出力したクエリテーブルのデータを、マクロブックの"Form"シートにおいた計算式で自動計算したデータ（24行4列＝1日分のデータ）を、
　年別ブックYEARwbへ代入、転記しています。（コード②の部分）
・1年365ファイルを処理するのに110秒程度、24年分だと45分以上かかってしまいます。
　コード①だけで確認したら約60秒かかりましたので、コード②（実際のコードはその後にもう少し続きますが）で約45～50秒かかります。
・コード②のWith～End With部分の代わりに、配列を利用したコード③も実行してみましたが、大して差はありませんでした。
　（そもそも配列をキチンと理解していないと思いますが。）
・因みに、変数"LastRow"で最終行を取得しているのは、1日分のデータ（24行4列）を日付順で下へ代入していくために、
　前日の処理の最終行を取得しています。

大量のファイル数を処理する①と②の部分を少しでも高速化できないかと思っています。どなたかお知恵をお貸し頂けないでしょうか。

Sub Test01()
'
    Application.ScreenUpdating = False
'
    Dim ThisWB As Workbook          'ThisWBはマクロファイル、"Form"と"Day"という2シート
    Dim YEARwb As Workbook             '年別ブック、20ファイル（20年分）
    Dim y As Long                   'データ年カウンター
    Dim m As Long                   'データ月カウンター
    Dim d As Long                   'データ日カウンター
    Dim YEARstr As String           '年シート名（文字列）、y（数値から変換）
    Dim YEARpath As String          '年別パス
    Dim YEARname As String          '年別ブック名
    Dim YMD As String               '時別データ年月日、365ファイル/年にyyyymmddのファイル名
    Dim HDname As String            '時別データブック名
    Dim QTcsv As QueryTable         'クエリテーブル
    Dim LastRow As Long             '時別シート最終行
'
    Set ThisWB = Workbooks("temp.xlsm")
    For Each qr In ThisWB.Queries
        qr.Delete
    Next
    HDpath = "C:\Users\User Name\Documents\CSV\"
'
'    年別ブックオープン
    For y = 2021 To 2000 Step -1
        YEARname = Dir(HDpath & y & ".xlsx")
        Set YEARwb = Workbooks.Open(Filename:=HDpath & YEARname)
        YEARstr = y
        YEARpath = HDpath & y & "\"
        ThisWB.Worksheets("Day").Activate
'
'    月日のループ
        For m = 1 To 12
            For d = 1 To 31
                LastRow = YEARwb.Worksheets(YEARstr).Cells(1048576, 2).End(xlUp).Row
                YMD = Format(y * 10000 + m * 100 + d, "0")
                HDname = Dir(YEARpath & YMD & ".csv")
                If HDname <> "" Then
'
'    ①クエリテーブルで時別データブックオープン
                    Set QTcsv = Worksheets("Day").QueryTables.Add("TEXT;" & YEARpath & HDname, _
                        Worksheets("Day").Range("A1"))
                    With QTcsv
                        .TextFileCommaDelimiter = True
                        .Refresh BackgroundQuery:=False
                        .Delete
                    End With
'
'    ②クエリテーブルから"Form"シートへデータ（24行4列）を代入
                   With YEARwb.Worksheets(YEARstr)
                        .Range(.Cells(LastRow + 1, 2), .Cells(LastRow + 24, 5)).Value = _
                            ThisWB.Worksheets("Form").Range("B2:E25").Value
                    End With
                    Worksheets("Day").Cells.ClearContents
                End If
            Next d
        Next m
'
        YEARwb.Save
        YEARwb.Close
    Next y
    Application.ScreenUpdating = True
    
    MsgBox "終了"
End Sub

' ③クエリテーブルから"Form"シートへデータ（24行4列）を代入
Dim Ary_in() As Variant
Ary_in = HrWSpu.Worksheets("Form").Cells(2, 2).Resize(24, 4).Value
Ywb.Worksheets(Ystr).Cells(LastRow + 1, 2).Resize(24, 4).Value = Ary_in

投稿者 : ヘンリー     投稿日時 : 2021/04/26(Mon) 19:22:13

---

CSVを読み込む方法としては、QueryTables以外に、
以下の2つが思いつきますが、速度の検証はしていません。
ご了承ください。

①FileSystemObjectを使う
②Open～Inputを使う

投稿者 : アンカー     投稿日時 : 2021/04/28(Wed) 15:50:27

---

ヘンリー様

アドバイスをありがとうございました。
頂いたヒントを基に更に調べてみたところ、FSOは高速化にはそれほど寄与しない旨書いている方が多くいましたので、一旦保留にしました。
Open～Inputは速いという評判でしたので、Line Inputで一行ずつ読み込む方法と、Getステートメントで全てのデータをバイナリモードで一括して読み込む方法を試してみました。参考にしたのは以下のサイトです。
https://www.moug.net/tech/exvba/0060089.html
結果的に、①の部分だけで、LineInputは1年分のデータで8秒の短縮、Getは18秒の短縮となりました。
これだけでもファイル数が24年分ありますので、7-8分短縮できました。とても助かりました。ありがとうございました。