VBA による高速テキスト出力
こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。
この記事の目次
目的
VBA では大量なデータを扱う事は出来ないと思われています。まぁ、実際、C++ と比べたら、プログラム言語であるという事ですら『?』が付きそうなほどですが。
そんな VBA ですが、サクッと使うには良いんです!
テキストファイルのダミーデータなどを作るのにはまさに良いんです!手軽さが!
ですが、大容量のダミーデータは現実的な時間で作成出来るのか、どの程度の容量のデータまでなら作れるのか……
そこで、テキストファイル出力の実行時間を測定します。
出力データは 50 万行× 2 列の半角スペース区切りのデータとします。
関数
ファイル出力方法①
出力データの 50 万行× 2 列の半角スペース区切りのデータは 1 列目は行数と同じ番号、 2 列目は乱数で 1 列目と 2 列目は半角スペースで区切られているデータ構造にします。ソースコード①
〜テキストファイル出力〜
50 万行× 2 列のデータを For 〜 Next で作成して、ファイルシステムオブジェクトでテキストファイルに出力するプログラムの実行時間を測定してみます。
Sub テキスト出力の実行時間測定1()
' プログラムの開始時刻を記録
開始時刻 = Time
' a 以上 b 以下の乱数作成する設定
a = 100
b = 350
' 50 万
データ数 = 500000
' カウンター
cnt = 1
' 出力するデータ格納用変数
データ = ""
' 50 万回繰り返す
For i = 1 To データ数
' データ変数が空なら
If データ = "" Then
' 1列目のデータ
データ = i
' 2列目のデータ
乱数 = Rnd() * (b - a + 1) + a
データ = データ & " " & 乱数
' データ変数に1回でも代入済みなら
Else
' 1列目のデータ
データ = データ & vbNewLine & i
' 2列目のデータ
乱数 = Rnd() * (b - a + 1) + a
データ = データ & " " & 乱数
End If
' 進捗をイミディエイトウィンドウに出力
If (i / データ数) * 100 > cnt Then
Debug.Print Application.WorksheetFunction.RoundDown((i / データ数) * 100, 0) & " % 完了 Time: " & Time
cnt = cnt + 1
End If
DoEvents
Next i
'////////////////////////////////////////////////////////////////////////////////////////////////////////
' 出力
'////////////////////////////////////////////////////////////////////////////////////////////////////////
Call データ出力("50万行×2列", データ)
'////////////////////////////////////////////////////////////////////////////////////////////////////////
' プログラムの終了時刻を記録
終了時刻 = Time
' プログラムの実行時間を計算
実行時間 = DateDiff("s", 開始時刻, 終了時刻)
' 実行時間をイミディエイトウィンドウに出力
Debug.Print "Start: " & 開始時刻 & vbNewLine & "End: " & 終了時刻 & vbNewLine & "実行時間: " & 実行時間 & " sec"
' プログラムの終了アナウンス
MsgBox "テキスト出力完了"
End Sub
'------------------------------------------------------------------------------
' 引数1:ファイル名(拡張子無)
' 引数2:出力文字列
' 動作:このExcelと同じ場所に引数2の内容を引数1で指定したファイル名で保存する。
'------------------------------------------------------------------------------
Sub データ出力(ByVal データ名, ByVal 出力内容文字列)
'変数を定義します
Dim FSO As Object
'オブジェクトを作ります
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.CreateTextFile(ThisWorkbook.Path & "\" & データ名 & ".txt")
.writeline 出力内容文字列
.Close
End With
' メモリの明示的開放
Set FSO = Nothing
End Sub
ソースコード①の実行時間
ソースコード①を実行しましたが、 10 分以上実行し続けて、 30 % 程度しかデータを作成出来ませんでした。『このままでは何分かかるか分からない』と思い、実行を中止しました。
実行開始から中止するまでのデータ作成率とその経過時間の一覧表を表1に示します。
また、図1にデータ作成率とその経過時間のグラフを示します。
ファイル出力方法②
ファイル出力方法①では For 〜 Next のループ速度がループ回数を重ねるにつれてどんどん遅くなっていきました。For 〜 Next のループ速度を高速かつ高速状態を維持するには、ループ回数が数回行われたら、ループ速度が遅くなる前にテキストファイル出力して、常にループ速度が速い状態になるようにすれば良いと思いました。
そこで、出力テキストを格納する変数が『ある byte 数』に達したら、テキストファイル出力する処理を追加しました。
出力テキストを格納する変数の容量は 100 byte 〜 1700 byte で 100 byte ずつ変化させました。
ソースコード②
〜テキストファイル出力〜
50 万行× 2 列のデータを For 〜 Next で作成して、データがある byte 数に達したら、テキストファイルに出力するプログラムの実行時間を測定してみます。
Sub テキスト出力の実行時間計測2()
' プログラムの開始時刻を記録
開始時刻 = Time
' a 以上 b 以下の乱数作成する設定
a = 100
b = 350
' 50 万
データ数 = 500000
' カウンター
cnt = 1
' 1回に出力するバイト数を設定する
' この変数を 100 ~ 1700 まで変更した
出力単位 = 1700
出力回数 = 0
' 出力するデータ格納用変数
データ = ""
' 50 万回繰り返す
For i = 1 To データ数
' データ変数が空なら
If データ = "" Then
' 1列目のデータ
データ = i
' 2列目のデータ
乱数 = Rnd() * (b - a + 1) + a
データ = データ & " " & 乱数
' データ変数に1回でも代入済みなら
Else
' 1列目のデータ
データ = データ & vbNewLine & i
' 2列目のデータ
乱数 = Rnd() * (b - a + 1) + a
データ = データ & " " & 乱数
End If
' 進捗をイミディエイトウィンドウに出力
If (i / データ数) * 100 > cnt Then
Debug.Print Application.WorksheetFunction.RoundDown((i / データ数) * 100, 0) & " % 完了 Time: " & Time
cnt = cnt + 1
End If
'////////////////////////////////////////////////////////////////////////////////////////////////////////
' 出力
'////////////////////////////////////////////////////////////////////////////////////////////////////////
If 出力単位 <= LenB(データ) Then
If 出力回数 = 0 Then
Call データ出力("50万行×2列", データ)
データ = ""
出力回数 = 出力回数 + 1
Else
Call データ追記("50万行×2列", データ)
データ = ""
出力回数 = 出力回数 + 1
End If
End If
'////////////////////////////////////////////////////////////////////////////////////////////////////////
DoEvents
Next i
' プログラムの終了時刻を記録
終了時刻 = Time
' プログラムの実行時間を計算
実行時間 = DateDiff("s", 開始時刻, 終了時刻)
' 実行時間をイミディエイトウィンドウに出力
Debug.Print "Start: " & 開始時刻 & vbNewLine & "End: " & 終了時刻 & vbNewLine & "実行時間: " & 実行時間 & " sec"
' プログラムの終了アナウンス
MsgBox "テキスト出力完了"
End Sub
Sub データ出力(ByVal データ名, ByVal 出力内容文字列)
'変数を定義します
Dim FSO As Object
'オブジェクトを作ります
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.CreateTextFile(ThisWorkbook.Path & "\" & データ名 & ".txt")
.writeline 出力内容文字列
.Close
End With
' メモリの明示的開放
Set FSO = Nothing
End Sub
Sub データ追記(ByVal データ名, ByVal 出力内容文字列)
fnsave = ThisWorkbook.Path & "\" & データ名 & ".txt"
numff = FreeFile
Open fnsave For Append As #numff
Print #numff, 出力内容文字列
Close #numff
End Sub
ソースコード②の実行時間
ソースコード②を実行したら、とても短い実行時間でデータ作成が完了しました。50 万行× 2 列の半角スペース区切りのデータが最短で『 14 秒』でテキストファイル出力が完了しました。
1度にテキストファイルへ出力するデータ容量とその出力実行時間の一覧表及びグラフを図2に示します。
コメント
14 秒実用的と思うか思わないかは個人差があると思います。
私は 50 万行× 2 列のテキストファイルが 14 秒で出来るのであれば実用的と思います。
以上