Excel VBAデータ登録のスピードアップしたい

質問

下記のようなコードがあります。

■input　データ閲覧・登録・編集シート
■data　データを格納するシート

inputシートとdataシートでdataの受け渡しを行っているのですが、データレコードを切り替えるだけで20秒ちょっとかかるため、作業効率が悪いです。
この時間を１～２秒ぐらいまで減らすには、どのように修正すれば、いいでしょうか？どうかアドバイスをお願いいたします。

Private Sub datatouroku()
’データを登録する

Dim touroku As Integer
Dim fRange As Range

Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

touroku = fRange.Row '検索されたNoの行位置を求める

Sheets("data").Cells(touroku, 1).Value = Range("BC1:BE1").Value
Sheets("data").Cells(touroku, 2).Value = Range("AX1").Value
Sheets("data").Cells(touroku, 3).Value = Range("I4").Value
　　'・・・上記のデータが全部で256件あります。

End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub hyouji()
'データを表示させる

Dim fRange As Range
Dim kensaku As Long

Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

　　　If (fRange Is Nothing) Then '見つからなかった？
　　　MsgBox "入力された顧客コードが存在しません。", vbExclamation
　　　Exit Sub
　　　End If

　　　kensaku = fRange.Row '検索された顧客DCの行位置を求める

　　　 Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value
　　　 Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value
　　　Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value
　　　　'・・・上記のデータが全部で256件あります。

Set trg = Sheets("data").Cells(kensaku, 1)
End Sub

回答No.3

mitarashi · ベストアンサー

#2です。
>試した結果では、複写範囲が広くなっても、処理時間が比例的に増加する事はありませんでした。
スミマセン。これ嘘でした。実行一回目はコンパイルの関係か、キャッシュの関係か時間がかかるので、見誤っておりましたが、やはりセル数に比例して処理時間は増加します。但し、個々に転送するのに比べて２０倍くらい速いです。まとめて転送する事で、セル数がバラの場合の２０倍以下でおさまるなら速度アップが期待できます。
この方法の場合は、数式を介しておりますので、再計算は自動のままにしておく必要がありますので、念のため付け加えさせていただきます。
ただ、単純なモデルで試した限りでは、256個の転送程度ならイラっとする程の時間はかからないと思いますので、遅くなる原因は他にあるのかもしれません。要所でGetTickCountを実行して、どこで時間がかかっているのかお調べになってはいかがでしょうか。

参考URL：

http://homepage1.nifty.com/MADIA/vb/API/GetTickCount.htm

お礼

mitarashi様
いつも本当にありがとうございます。既にNO2で頂いた回答で既に劇的に早くなりました。20秒から１秒以下にまで縮まりました。なんてお礼を言ったらよいか・・。なぜこんなに早くなるのか、いまいち理解仕切れていませんので、そこもしっかり勉強していくつもりです。
本当にありがとうございました。

回答No.2

mitarashi

１．まずデータ転記部分を

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
’ここに転記処理を記す
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

で囲むと、処理時間半減位にはなると思います。

２．それ以上の高速化には、範囲まとめて値転写するのが速いと思います。
バラバラのセル→一行書き込みでは、作業用のシートに数式で一旦受けて、一行にまとめる様にしておいて、
Sheets("Sheet3").Rows(1).Value = Sheets("Sheet4").Rows(1).Value
といった感じで値のみ代入すれば良いでしょう。
一行→バラバラのセルの場合も、同じセル配置の作業用のシートを設けて、
一行のデータから目的の配置に関数で転記して、
Sheets("Sheet5").Range("A1:T20").Value = Sheets("Sheet4").Range("A1:T20").Value
といった感じで、定数的な見出し文字といった情報もひっくるめて目的のシートに値を転記すれば速いと思います。
試した結果では、複写範囲が広くなっても、処理時間が比例的に増加する事はありませんでした。
検索してヒットした行から、作業シートのバラバラのセルに値を移すには、INDEX関数を用いるなり、作業用のシートの所定の行に一旦コピーしても良いでしょう。
なお、この方法だと、転記先のシートの書式情報はそのまま保持されます。
但し、貼付先の書式によっては、転写元の空白が、転写先で0になってしまうといった問題が出るかもしれません。

以上、ご参考まで。

回答No.1

mks1902

＞If (fRange Is Nothing) Then '見つからなかった？
＞MsgBox "入力された顧客コードが存在しません。", vbExclamation
＞Exit Sub
＞End If

件数が多いとIF～THEN命令は不向きです。私も経験しました。
ヒントとして
IF～THEN命令のところをオートフィルタで顧客コードを抽出。
結果をコピーし、別のシートに貼り付け。
counta関数で抽出件数を出す。
０件なら顧客コードが存在しない
１件ならヒット
２件以上なら重複

頑張ってみてください。

お礼

mk1902様
回答ありがとうございました。
まだトライできていませんが、是非活用させていただきたいと思います。
勉強になりました。
ありがとうございます。