【VBA備忘録】もっと爆速！複数の別ブックを開かずに値を取得する(テキスト編)

テキストの値を爆速で集めれる方法があるらしい

別ブックから値を取得するのに
ブックを開かずに非表示で開く方法で結構速くなったと思うんですが…

CSVなどで作成されたテキストデータを複数処理しなければならない、しかもコンマ区切りとかタブ区切りされていて
区切り位置で区切ってからExcelで処理したい場合
そんなときテキストデータを1行ずつ取得する方法がめっちゃ爆速でしたので、ぜひみなさんご活用ください。

マクロの動作説明

①指定のフォルダにあるテキストデータの値を取得→読み込み済みフォルダに移動する

デスクトップにある「データ」というフォルダに「YYYY-MM-DD-HHMMSS.csv」というデータが溜まっていく環境だとします。
中身の値を取得→取得したデータは「読み込み済み」フォルダに移動
すべてのデータが読み込み済みに移動するまで繰り返します。

ファイルの保存フォルダを移動（Nameステートメント）

Name 【移動前のファイルパス】 & “\" & 【ファイル名】 As 【移動先のファイルパス】 & “\" & 【ファイル名】 

Sub Sample1()
Dim svadd As String, file As String

svadd = "C:\Users\Shishido46\Desktop\データ" '保存場所

'読込済みフォルダを作成
If Dir(svadd & "\読み込み済み", vbDirectory) = "" Then
    MkDir svadd & "\読み込み済み"
End If
        
file = Dir(svadd & "\" & "*.csv")

'フォルダにあるCSVを順番に処理
Do While file <> ""

'=====処理=====

'読込済みフォルダに移動
Name svadd & "\" & file As svadd & "\読み込み済み\" & file
'引数なしDir …引数を引き継いだ次のファイル名を返す
file = Dir
Loop

End Sub

②ファイルの中身を変数に格納し、変換する

対象のテキストデータ（CSV）はカンマ区切りされており、中身は部品発注データになります。

ただしシステムの関係で2列目と7列目は「YYYYMMDD」となっていて、Date型（日付形式）ではないため
取得し格納する際にDate型に変換します。

ファイルをオープンする

爆速のポイントはCSVをOpenメソッドではなくOpenステートメントを使うことです。
Openステートメントは、Excelでブックを開くのとは違い、ファイル番号を指定することでテキストファイルを独占的に使えるようにしています。（私もよくわかりませんが、とにかく速いです）

ファイル番号を指定する（FreeFile関数）

ファイル番号（変数）=FreeFile

テキストファイルを開く（Openステートメント）

Open 「ファイル名」 For オープンの種類 As #ファイル番号（変数）

オープンの種類は
・読込：　Input
・書込：　Output
・追記：　Append
の3種類ありますが、読み込むだけなので「Input」を使います。
処理がおわったら Close #ファイル番号（変数）をするのも忘れずに！

ファイルの中身を読み込む

Openステートメントで開いたテキストデータを1行ずつ読み込んでいきます。
まずDo Until～Loopで条件を満たすまでループ→ 条件にEOF関数を使います。
EOF関数は現在の読込位置が最終行だとTrueを返すので最終行まで繰り返すことになります。

最終行まで繰り返す（Do Until～Loop / EOF関数）

Do Until EOF(ファイル番号（変数））

Do Until～Loopの中で読み込み処理をします。
Line Inputステートメントで変数に1行代入します。

データを1行変数に代入する

Line Input #(ファイル番号）,変数

読み込んだ中身を分割して変数に代入して一次元配列にする

Line Inputで読み込んできたデータは
1,20241001,Aの部品,2000,30,60000,20241009
カンマで区切られた1行のデータです。
これをSplit関数を使って分割します。

分割する

変数 = Spilit( 区切りたい文字列（変数） , " 区切る文字 “）

1つの配列（box）に集める

そのまま1行ずつ集計シートに貼り付けていってもいいのですが、私は貼り付けはまとめて一気にしたいタイプなので
二次元配列（box）に入れ直してその配列を集計シートに貼り付けます。
arreyの中身+データの不具合などでデータの見返しが必要な可能性があるので、CSVのファイル名も追加で載せます。
ReDimで配列を大きめに作っておき後で小さくして貼り付けるのですが、今回は絶対ここまでは来ないという行数（0-3000）と列数は決まっているため0-7（No. /発注日/部品名/発注数/単価/金額/納期/ファイル名）としてあります。
For～Nextで一次元配列（arrey）の列を順番にループし、二次元配列（box）に突っ込んでいきますが
この時、配列の列番号が1（発注日）と6（納期）は文字列→日付型に変更します。
日付にするのは結構力業ですが、Left/Mid/Right関数を使っています笑

Sub Sample2()

    svadd = "C:\Users\Shishido46\Desktop\データ" '保存場所
    file = "2024-09-30-111956 - コピー.csv" '対象のCSVデータ

    'データを開く
    filenum = FreeFile
    Open svadd & "\" & file For Input As #filenum
    
    '格納するための配列（大きめに設定）
    ReDim box(3000, 7)
    
    'ファイルの中身を順番に読み込んでいく＝＝＝＝＝＝＝＝＝＝＝
    Do Until EOF(filenum)
        
    '1行読込んでbufに代入
    Line Input #filenum, buf
    
    'bufをカンマ区切りで分割してarreyに代入    
    arrey = Split(buf, ",")
        
        For j = 0 To UBound(arrey)
        
            If j = 1 Or j = 6 Then
            box(n, j) = DateSerial(Left(arrey(j), 4), Mid(arrey(j), 5, 2), Right(arrey(j), 2)) '日付に変更
            Else
            box(n, j) = Trim(arrey(j)) '空白を削除しながらbに二次元配列を入れていく
            End If
            
        Next j
        
    'ファイル名を格納
    box(n, 7) = file
            
    n = n + 1
    
    Loop
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

    n = 0
    Close #filenum
End Sub

③集計シートに集める

CSVのデータを「集計シート」に貼り付けていきます。
フォルダにあるデータをすべて読み込みし、順番に貼り付けます。

'最終行を取得
saigo = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1

'集計シートに代入
ws.Range("A" & saigo).Resize(n, UBound(arrey) + 2) = box
n = 0

CSVの値を爆速で集める

動作説明にあったとおり動かしていきます。
しかも爆速でな。
他ブックを開いて閉じてもしないので画面もチラチラしないのもかっこいい…！

Sub 爆速で集計する()
    
Dim wb As Workbook
Dim ws As Worksheet
    
Set wb = ThisWorkbook
Set ws = wb.Worksheets("集計シート")
    
Dim svadd As String

svadd = "C:\Users\Shishido46\Desktop\データ"
    
'読込済みフォルダを作成（svaddに読込済みフォルダがない場合）
If Dir(svadd & "\読み込み済み", vbDirectory) = "" Then
    MkDir svadd & "\読み込み済み"
End If
    
Dim file As String

'Dirでファイルを取得    
file = Dir(svadd & "\" & "*.csv")

'nは行数の累計カウントです、最後に貼り付ける時使います。
n = 0
    
'フォルダ内を順番にループ--------------------------------------
Do While file <> ""
    
    '開く
    filenum = FreeFile
    Open svadd & "\" & file For Input As #filenum
    
    '格納するための配列（大きめに設定しておきます、足りなかったら3000を変更）
    ReDim box(3000, 7)
    
    'ファイルの中身を順番に読み込んでいく＝＝＝＝＝＝＝＝＝＝＝
    Do Until EOF(filenum)
        
    '一行読込み
    Line Input #filenum, buf
    
    'bufをカンマ区切りで分割してarreyに代入
    arrey = Split(buf, ",")
        
        For j = 0 To UBound(arrey)
        
            If j = 1 Or j = 6 Then
            box(n, j) = DateSerial(Left(arrey(j), 4), Mid(arrey(j), 5, 2), Right(arrey(j), 2)) '日付に変更
            Else
            box(n, j) = Trim(arrey(j)) '空白を削除しながらbに二次元配列を入れていく
            End If
            
        Next j
        
    'ファイル名を格納
    box(n, 7) = file
            
    n = n + 1
    
    Loop
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    
    '最終行を取得
    saigo = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        
    '集計シートに代入
    ws.Range("A" & saigo).Resize(n, UBound(arrey) + 2) = box
    n = 0
    Close #filenum

    Name svadd & "\" & file As svadd & "\読み込み済み\" & file
    file = Dir    '引数なしDir …引数を引き継いだ次のファイル名を返す

Loop
'-------------------------------------------------------------------


MsgBox "処理が終わりました"

End Sub

VBA,白猫CSV,Open,VBA,業務改善,高速化

Posted by shironecoworks