【VBA備忘録】もっと爆速！複数の別ブックを開かずに値を取得する(テキスト編)
テキストの値を爆速で集めれる方法があるらしい
別ブックから値を取得するのに
ブックを開かずに非表示で開く方法で結構速くなったと思うんですが…
https://indoor-nekura.work/vba_otherbook_open_super/CSVなどで作成されたテキストデータを複数処理しなければならない、しかもコンマ区切りとかタブ区切りされていて
区切り位置で区切ってからExcelで処理したい場合
そんなときテキストデータを1行ずつ取得する方法がめっちゃ爆速でしたので、ぜひみなさんご活用ください。
マクロの動作説明
①指定のフォルダにあるテキストデータの値を取得→読み込み済みフォルダに移動する
デスクトップにある「データ」というフォルダに「YYYY-MM-DD-HHMMSS.csv」というデータが溜まっていく環境だとします。
中身の値を取得→取得したデータは「読み込み済み」フォルダに移動
すべてのデータが読み込み済みに移動するまで繰り返します。
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
Open 「ファイル名」 For オープンの種類 As #ファイル番号（変数）
オープンの種類は
・読込： Input
・書込： Output
・追記： Append
の3種類ありますが、読み込むだけなので「Input」を使います。
処理がおわったら Close #ファイル番号（変数）をするのも忘れずに！
ファイルの中身を読み込む
Openステートメントで開いたテキストデータを1行ずつ読み込んでいきます。
まずDo Until～Loopで条件を満たすまでループ→ 条件にEOF関数を使います。
EOF関数は現在の読込位置が最終行だとTrueを返すので最終行まで繰り返すことになります。
Do Until EOF(ファイル番号（変数））
Do Until～Loopの中で読み込み処理をします。
Line Inputステートメントで変数に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 = 0CSVの値を爆速で集める
動作説明にあったとおり動かしていきます。
しかも爆速でな。
他ブックを開いて閉じてもしないので画面もチラチラしないのもかっこいい…！
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