Access2000のVBAコードの最適化

質問

お世話になります。
Access2000のVBAでコードを作成したのですが、
処理をもっと早く出来る方法ありましたら教えて頂ければと
思います。

処理している内容としては、
(1)データ元のエクセルファイルを開く
(2)エクセルファイルに記載されているセルの内容をAccessに挿入
※取り込み開始・終了が200回程繰り返す
※While (oApp.Sheets(sheet).cells(iRow, 1) <> "")のループは500回程繰り返す

少しでも処理を速くする方法があれば教えて頂きたいので
宜しくお願い致します。

------------ソース----------------
Set oApp = CreateObject("Excel.Application")
oApp.Workbooks.Open FileName:=CurrentProject.Path & "\メイン.xlsm"
---------------取り込み開始-------------
rs2.Open "選手", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iRow = 2
sheet = "program"

rs.Open "選手情報_選手ID", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iRow = 2 ' ★
sheet = "program"
While (oApp.Sheets(sheet).cells(iRow, 1) <> "")
rs.Filter = "日=" & oApp.Sheets(sheet).cells(iRow, 2)
rs.Filter = rs.Filter & " and 場=" & oApp.Sheets(sheet).cells(iRow, 1)
rs.Filter = rs.Filter & " and 番号=" & oApp.Sheets(sheet).cells(iRow, 3)
If (rs.EOF) Then
rs.AddNew
rs("日") = oApp.Sheets(sheet).cells(iRow, 2)
rs("場") = oApp.Sheets(sheet).cells(iRow, 1)
rs("番号") = oApp.Sheets(sheet).cells(iRow, 3)
End If
rs("1番") = oApp.Sheets(sheet).cells(iRow, 5)
rs("2番") = oApp.Sheets(sheet).cells(iRow, 5 + 26)
rs("3番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26)
rs("4番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26 + 26)
rs("5番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26 + 26 + 26)
rs("6番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26 + 26 + 26 + 26)
rs.Update
iRow = iRow + 1
Wend

rs.Close
---------------取り込み終了-------------
---------------取り込み開始-------------
rs.Open "選手情報_選手名", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iRow = 2 ' ★
sheet = "program"
While (oApp.Sheets(sheet).cells(iRow, 1) <> "")
rs.Filter = "日=" & oApp.Sheets(sheet).cells(iRow, 2)
rs.Filter = rs.Filter & " and 場=" & oApp.Sheets(sheet).cells(iRow, 1)
rs.Filter = rs.Filter & " and 番号=" & oApp.Sheets(sheet).cells(iRow, 3)
If (rs.EOF) Then
rs.AddNew
rs("日") = oApp.Sheets(sheet).cells(iRow, 2)
rs("場") = oApp.Sheets(sheet).cells(iRow, 1)
rs("番号") = oApp.Sheets(sheet).cells(iRow, 3)
End If
rs("1番") = oApp.Sheets(sheet).cells(iRow, 1 + 5)
rs("2番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26)
rs("3番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26)
rs("4番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26 + 26)
rs("5番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26 + 26 + 26)
rs("6番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26 + 26 + 26 + 26)
rs.Update
iRow = iRow + 1
Wend

rs.Close
---------------取り込み終了-------------

回答No.1

ShowMeHow · ベストアンサー

早くなるかどうかは、実験してみないとわかんないけど
ＡＤＯでエクセルにアタッチしてみたらどうだろう。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_090.html

あと、アクセスのインサートはＳＱＬ一発のほうが早いと思う。
http://www.1keydata.com/jp/sql/sql-insert-into.php

回答No.4

queuerev2

No.3です。
コードに
oApp.Sheets(sheet)
とたくさん書きならべてありますが、
これは書きならべないでWithを使うか変数にsetしてから使うかのどちらかにしたほうが速度が少し速くなると思います。

お礼

ありがとうございます。
setしたいと思います。

回答No.3

queuerev2

AccessのことはさっぱりわからないExcelユーザです。
Excelのブックは１つでCellsはたくさん実行するのですね。
もしもそのブックに数式がたくさん存在するなら、再計算による速度低下が無視できないくらいあるかもしれません。
（数式が少なければ再計算の影響はわずかと思われます）

もしそうであれば、再計算を停止することで高速化するはずです。
方法ですが、
最初の取り込み開始の前に
oApp.parent.Calculation = -4135 'xlCalculationManual
最後の取り込み終了の後に
oApp.Calculation = -4105 'xlCalculationAutomatic
と入れます。

あるいは、もしも何らかの方法でiRowの最大値がわかるなら、
たとえばそれがiRowMaxとして、
dim xsarray as variant
with oapp.sheets(sheet)
xsarray=.range(.cells(1,1), .cells(iRowMax, 5 + 26 + 26 + 26 + 26 + 26))
end with
のようにして２次元配列として一気に取り込めば、再計算を停止しなくても再計算による速度低下の影響は少ないと思います。
（その後２次元配列xsarrayから所定の変数へ代入します）
ただ、本質問のケースでは配列がかなり大きくなりそうなのでその点が心配です。

お礼

ありがとうございます。
数式はケースでした。

回答No.2

ShowMeHow

別件の質問のヒントだけど、、、
この質問を見る限りでは、エクセルマクロでセルに値を書くことはできるし、
アクセスから書かれた値を読むことはできるんだよね。

あとは、定期的に見張るって部分だけど、一般的には
ｖｂで言うところの、timer　コントロールみたいなものがないから、
loop のなかにSleepをくみこんで、監視すると良いと思いますよ。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1013207350

お礼

＞別件の質問のヒントだけど、、、
＞この質問を見る限りでは、エクセルマクロでセルに値を書くことはできるし、
＞アクセスから書かれた値を読むことはできるんだよね。
ご教授頂きまして、まことにありがとうございます。
お手本がないと何もできない馬鹿ですので。。
アドバイスありがとうございます。