EXCEL VBAによるEXCELファイル作成時の高速化案がありますでしょうか。

質問

EXCEL VBAによるEXCELファイル作成時の高速化案がありますでしょうか。

行いたい内容は、以下の通りです。

１．CSVファイルの1行目をフィールド名としてシートの1行目に記述する。
　　※フィールド数は、いつも同じとは限りません。
２．CSVファイルの内容の取得の際に、抽出条件の指定が発生する事がある。
　　※データ量と抽出条件の兼ね合いで、SQLでデータを取得しています。

また、データ数は、サンプルでは5万行程度。
今後は、6万行を超えていく予定です。この際は一定の件数毎に書き出すEXCELファイルを増やしていく予定です。

このEXCELファイルへの書き出し方法の場合、私のPCでは5万行の場合、5分程かかります。
処理方法を変更する事によって、処理速度の改善は見込めるものでしょうか。

なお、あくまで5分と言う数字がダメなのではなく、よりスピードが上がれば、データ件数が増えた際にも、快適であろうと言う程度であります。

皆様のお知恵を拝借出来ればと思っております。
よろしくお願いいたします。

--------------------------------------------------------------------------------
以下のように、SQLを使って、CSVファイルからデータを取り出し、EXCELファイルを新規に作成しています。
（エラー処理等は省いております。）
--------------------------------------------------------------------------------

'設定。
strDIR = "C:\temp"
strCSV = "sample.csv"
strFileName = "output.xls"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & strDIR & ";" & "Extended Properties=""Text;HDR=YES;FMT=Delimited"""

'画面の自動更新をOFF
Application.ScreenUpdating = False

'新しいEXCELファイルをデータと同じディレクトリに作成。（旧バージョンでの互換性を維持）
Set Newbook = Workbooks.Add
Newbook.SaveAs Filename:=strDIR & "\" & strFileName, FileFormat:=xlNormal
Newbook.Activate
Set objSheet = Newbook.Sheets("Sheet1")

'データ取得。
Set objDB = CreateObject("ADODB.Connection")
objDB.Open strCon
Set objRes = objDB.Execute("SELECT * FROM " & strCSV)

'1行目にフィールド名を記述。
For m = 0 To (objRes.Fields.Count - 1)
objSheet.Range("A1").Cells(1, (m + 1)).Value = objRes.Fields(m).Name
Next m

'2行目からデータ記述。
GYO = 2
Do Until objRes.EOF = True
For k = 0 To (objRes.Fields.Count - 1)
objSheet.Range("A1").Cells(GYO, (k + 1)).Value = objRes(k)
Next k
GYO = GYO + 1
objRes.MoveNext
Loop

'EXCELファイルの保存
Newbook.Save

'後処理。
objDB.Close
Set objRes = Nothing
Set objDB = Nothing

'画面の自動更新をON
Application.ScreenUpdating = True

回答No.1

KenKen_SP · ベストアンサー

こんにちは。

> '2行目からデータ記述。
> GYO = 2
> Do Until objRes.EOF = True
> For k = 0 To (objRes.Fields.Count - 1)
> objSheet.Range("A1").Cells(GYO, (k + 1)).Value = objRes(k)
> Next k
> GYO = GYO + 1
> objRes.MoveNext
> Loop

の部分を Range("A2").CopyFromRecordset objRes に置き換えてみたら？

一概には言えませんが、1データ毎にセルに順次書込みするよりは、速い
のではないかと思いますよ。

　　■VBA HELP 引用 Microsoft ActiveX Data Object Library 参照

　　expression.CopyFromRecordset(Data, MaxRows, MaxColumns)

　　解説
　　コピーは Recordset オブジェクトのカレント レコードの位置から
　　行われます。コピーが完了すると、Recordset オブジェクトの EOF
　　プロパティは True になります。

> この際は一定の件数毎に書き出すEXCELファイルを増やしていく予定です。

これは、引数 MaxRows が利用できますね。

あと、CSV ファイルなので Schema.ini なんかも必要かもしれません。

[MSDN:CopyFromRecordset メソッド]
http://msdn.microsoft.com/ja-jp/library/cc362496.aspx

[三流君ASP:ADO CSV接続 schema.iniを使い型を設定してみた]
http://www.ken3.org/asp/backno/asp102.html

では。

お礼

お返事が遅くなりまして、申し訳ありません。

CopyFromRecordsetを使用する方法に変更してみました。
そして、8万行のCSVファイルを2つのエクセルファイルに読み込む処理を作成した所、なんと、数十秒で処理が完了しました。

驚くほどの速度改善となりました。
本当に、ありがとうございます！
感謝するばかりでございます。

知識と言うものは素晴らしいと改めて実感した次第です。
VBAのおもしろさも、もちろん、実感した次第です。

閲覧されている他の方々にも参考になるかと思いますので、サンプルを以下に提示します。

８万行のCSVを５万行ずつエクセルに分割するサンプルです。

'全データの取得。
Set objRes = objDB.Execute("SELECT * FROM sample.csv")

For i = 1 To 2

Set Newbook = Workbooks.Add
Newbook.SaveAs Filename:=example_" & i & ".xls, FileFormat:=xlNormal
Newbook.Activate
Set objSheet = Newbook.Sheets("Sheet1")

'1行目にフィールド名を記述。
intFieldMax = objRes.Fields.Count - 1
For m = 0 To intFieldMax
objSheet.Range("A1").Cells(1, (m + 1)).Value = objRes.Fields(m).Name
Next m

'データの取得。
tmp = Range("A2").CopyFromRecordset(objRes, 50000)

Newbook.Save

'EOFがTrueになるので、最初に戻す。
objRes.MoveFirst
'すでに取得したデータを飛ばす。
objRes.Move (50000 * i)

Next i

なお、動作確認は、Excel2000、Excel2007で行いました。

回答No.2

o_chi_chi

・複数使用しかつ変わらない値は一端変数へ代入する。
lngMax = objRes.Fields.Count - 1

・修飾を省略しない。
objRes.fields.Item(k)

・Withステートメントを使う。
With objRes

微々たる改善ですが。

お礼

お礼が遅くなりまして申し訳ありません。

CopyFromRecordsetの使用と合わせて、繰り返し同じ値を参照する部分の計算は、変数にまとめてみました。

驚くべき改善がみられ、感謝するばかりでございます。

本当にありがとうございました！