【現在処理時間45分】EXCEL関数での時間短縮をさせたい。

質問

お世話にまります。
■相談概要
AccessからADO接続で下記のDBシートと、計算シートの作業者と作業者番号作成させますここまでの処理は問題はないのですが
■問題点
計算シートで計算させる時に時間が約45分くらいかかります
原因は計算シートに700列ぐらいあり行数は55あります
計算すると38500のセルに関数を入れているのが原因です。
関数は=SUMPRODUCT((DB!$C$1:$C$60000=$C21)*(DB!F$1:$F$60000=$F$17)*(DB!E$1:$E$60000))です
関数はVBAで自動に作成させています

■規則
計算シートは決められたフォーマットなので変更したくてもできません

DBシート
日付|管理番号|作業者番号|数量
6/3 |00100001|01 |1
6/4 |00100001|01 |2
6/3 |00100001|04 |2
6/3 |00100002|04 |3
6/5 |00100001|08 |3
6/6 |00100001|08 |1
6/8 |00100001|08 |6
6/3 |002F000 |01 |1

計算後シート
作業者番号|01 　|04 |08 |
作業者　 ｜太郎|次郎｜三郎|
管理番号 ｜
00100001 ｜3　｜2 ｜10 |
00100002 ｜ 　｜3 | |
002F001 ｜ 　｜ | |　　
00105006 ｜ 　｜ | |
002F000 ｜1　｜ | |

どなたか計算の時間短縮等わかる方ご教授よろしくお願い申し上げます。

回答No.5

hotosys · ベストアンサー

Sub sample()
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim srcRow As Long
Dim dstRow As Integer
Dim dstColumn As Integer
Dim rng As Range
Set srcSheet = Sheets("DBシート")
Set dstSheet = Sheets("計算後シート")
dstSheet.Range(dstSheet.Range("B4"), dstSheet.Range("A1").End(xlDown).Offset(0, dstSheet.Range("A1").End(xlToRight).Column - 1)).Clear
For srcRow = 2 To srcSheet.Range("B2").End(xlDown).Row
Set rng = dstSheet.Columns("A:A").Find(srcSheet.Cells(srcRow, 2), LookIn:=xlValues, lookat:=xlWhole)
If rng Is Nothing Then
MsgBox "管理番号:" & srcSheet.Cells(srcRow, 2) & " がありません"
Exit Sub
End If
dstRow = rng.Row
Set rng = dstSheet.Rows("1:1").Find(srcSheet.Cells(srcRow, 3), LookIn:=xlValues, lookat:=xlWhole)
If rng Is Nothing Then
MsgBox "作業者番号:" & srcSheet.Cells(srcRow, 2) & " がありません"
Exit Sub
End If
dstColumn = rng.Column
dstSheet.Cells(dstRow, dstColumn) = dstSheet.Cells(dstRow, dstColumn) + srcSheet.Cells(srcRow, 4)
Next
End Sub

補足

お返事ありがとうございます
ぐおおおおおお～～～感激しました。
できるものでね、すげ～
ありがとうございます
もうひとつだけお願いしたいのですが

■解読できたところ（管理番号）
列の場所を変えるには下記を変更しただけでOKでしたが
Set rng = dstSheet.Columns("C:C")
・厳密はC21より下へ

■解らないところ（作業番号）
作業番号をF:17より右へBH:17まで

■計算された値の貼り付け
値の貼り付け開始はF21より

しつこくてすみません最後にしますので、ご教授お願いしますｍ（＿＿）ｍ

回答No.7

hotosys

管理者番号がC21から下へある場合
Set rng = dstSheet.Columns("C:C").Find(...
でもいいが、最大がわかっているなら（または適当に）
Set rng = dstSheet.Range("C21:C250").Find(...
でもいい。
ちゃんと有効データで出すなら、
Set rng = dstSheet.Range(dstSheet.Range("C21"), dstSheet.Range("C21").End(xlDown)).Find(...
ただし、これは最低dstSheet.Range("C22")まではデータがある事が前提
Set rng = dstSheet.Range(dstSheet.Range("C21"), dstSheet.Range("C65536").End(xlup)).Find(...
がExcel2007までは正しかったが、Excel2007の最大行にも対応させると
Set rng = dstSheet.Range(dstSheet.Range("C21"), dstSheet.Range("C" & dstSheet.Rows.Count).End(xlUp)).Find(...
になるが、どれでも好きな物を。

作業番号はF:17より右へBH:17までと決まっているなら
Set rng = dstSheet.Range("F17:BH17").Find(...
で求められる。

管理番号がC21からで作業者番号がF17からなら、計算された値の貼り付けはF21になるはずなので、他の変更は無いと思う。

後はクリアの部分を直す必要がある
面倒なので、
dstSheet.Range("F21:BH65536").Clear
などと適当にクリアしてもいい。

回答No.6

hallo-2007

No3です。
ちょっと思ったのですが、
＞関数は=SUMPRODUCT((DB!$C$1:$C$60000=$C21)*(DB!F$1:$F$60000=$F$17)*(DB!E$1:$E$60000))です
＞関数はVBAで自動に作成させています
なぜにVBAで作成する必要がなるのでしょうか、先に計算後シートに
数式入れて、計算を手動にしておいて、必要時に再計算すると良いように思うのですが？
VBAのコードで既に回答が出ていますので理解して運用してください。
計算後シートに特別な理由があるのであれば、
別途、ピボットテーブル案で所定シートのセルに値を入れるシートですが
先にピボットテーブル作成しておいて
計算後シート
　　　A　　　　B　　　C　　D
1　作業者番号|01 　|04 |08 |
2　作業者　 ｜太郎|次郎｜三郎|
3　管理番号 ｜
4　00100001
5　00100002
B4セルに　=INDEX(ピボットシート!$1:$65536,MATCH($A4,ピボットシート!$A:$A,FALSE),MATCH(B$1,ピボットシート!$4:$4,FALSE))
で右フィル、下フィルして速度の確認してみてください。
エラー処理はしていません。
VBAで計算する方法
SUMPRODUCT関数を入れておいて再計算させる方法
ピボットテーブルの値から引っ張ってくる方法
処理の速い方法選んでみてください。

回答No.4

imogasi

関数の計算が処理時間的に大変であるのだったら、VBAでやればよいでしょう。
しかし、＞=SUMPRODUCT((DB!$C$1:$C$60000=$C21)*(DB!F$1:$F$60000=$F$17)*(DB!E$1:$E$60000))です
は何をやっているのか。回答者はテストを受けているのではないので、読解させず、文章で質問文において説明すること。
ーー
関数式を見ると
第１行－第６００００行に渉って、各行において、３条件をAND条件的に判定しているだけでしょう。
VBAでやれば６００００行読み終わると完了し、３比較などメモリ内の変数比較３回するだけでしょう。足し算１回と。すぐ終ると思う。
VBAが判るなら、すぐ実現する。
コード数は約１０行の見込み。
＞原因は計算シートに700列ぐらいあり行数は55あります
と式の６００００行の関係がわからない。
２００７ですか。バージョンを書いてない。

お礼

お返事ありがとうございます

補足

お返事ありがとうございます
関数においての補足等に付きましては申し訳ありません
お答えしていただいたとおりです。
60000行に関してはDBシートにどれくらいの値が入るかわからないので
とりあえず60000行にしてみました。

又、ＥＸＣＥＬのバーションは2003です
ＶＢＡで、できますか？
よろしければご教授ねがいませんか？
言葉ではなくＶＢＡコードで願います

回答No.3

hallo-2007

ご存知かと思いますが、SUMPRODUCTの様な配列関数は多用するとパソコンの負担が増え、動作が遅くなります。
現状のVBAでが、上記の関数を書き加えるたび再計算しているのでしょう。
VBAで処理するのであれば、DBシートを順に検索して
条件によって、計算後の各セルに振り分けて足していく方法に変える手法もありそうですが。
表を見る限り、ピボットテーブルを一度作成すると一発の様な気がします。
2度目からは、ピボットテーブルのデータの更新　をクリックするだけです。この方法ではダメなのでしょうか。

お礼

お返事ありがとうございます

補足

当方もピボットテーブルが使えれば問題は解決するのですが仕様が決まっております。
できればＮｏ１様の言うＶＢＡコードで作れれば理想的なのですが・・
どなたか救世主様がいらっしゃれば・・・・・泣
これにかれこれ3ヶ月ぐらいは悩んでます

回答No.2

Masa2072

ANo.1さんの回答に補足
「計算方法」の変更はVBA内で行えます。
計算シートの処理に入る前に
Application.Calculation = xlCalculationManual
マクロ終了前に
Application.Calculation = xlCalculationAutomatic
を行います。

お礼

お返事ありがとうございます

補足

お返事ありがとうございます
はい、計算時期は当方も考えました。
自動での計算をキャンセルし必要なときに計算させています
説明少なくてすみません
今の時点ではＶＢＡでの処理が、一番有力かと思い始めてきました。

回答No.1

sippo06

こんばんわ

EXCELはセル１個の値が変わるたびに、シート内の関数をすべて再計算してしまうようです。
そこで、以下で多少改善されるかもしれません。
（これは、EXCEL2000、2003の方法なので、そのほかのバージョンだったらごめんなさい）
1.マクロを実行する前に該当のファイルを開く
2.メニューの「ツール」-「オプション」で表示されるダイアログの「計算方法」を選択
3.「手動」のオプションを選択し、「OK」を押す
4.VBAを実行
5.3のダイアログで「再計算を実行」ボタンをクリック

お礼

お返事ありがとうございます

補足

お返事ありがとうございます
自動計算処理は実行しています
説明少なくてすみません