処理時間がかかりすぎます

質問

いろいろ調べながらマクロを書いたのですが時間がかかりすぎます。
どのうようにすれば時間短縮が図れるのでしょうか。

Sub sample()
Dim tuki As Integer
Dim bango As Integer
Dim tukihi As Integer
Dim c As Range
For tuki = 1 To 12
For bango = 11 To 1000
For tukihi = 14 To 19
With Worksheets(Format(tuki) & "月").UsedRange.Rows(3)
Set c = .Find(what:=Worksheets("年間予定表").Cells(bango, tukihi).Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Worksheets("年間予定表").Range("N1") = c.Address
Worksheets(Format(tuki) & "月").Range(c.Address).Offset(bango - 3, 0) = _
Worksheets("年間予定表").Cells(bango, 3).Value & _
Worksheets("年間予定表").Cells(bango, 2).Value & _
" , " _
& Worksheets("年間予定表").Cells(bango, 21).Value

End If
End With
Next tukihi
Next bango
Next tuki
End Sub
Sub youbi_s

回答No.3

popuplt

For ～　Next　によってセル毎にデータを書き出していませんか？
（７万回くらい書き出しているのかな？）

せめて月単位で計算値を２次元配列において、１回で書き出す様にすれば早くなると思います。

お礼

ありがとうございます。
すいません、初心者名もので具体的にご教授願えませんか？

回答No.2

tom04

こんばんは！
すべての行が1000行までループするようになっていますが、
実際のデータは1000行までデータはあるのでしょうか？

一例として
＞For bango = 11 To 1000
の行を
＞For bango = 11 To Cells(Rows.Count, tukihi).End(xlUp).Row
のように変更する。

そしてNo.1さんが仰っているように、Loopの最初と最後に1行ずつ追加して

＞Dim c As Range
＞For tuki = 1 To 12
・・・・・
・・・・・
＞Next tuki
＞End Sub
を
＞Dim c As Range
＞Application.ScreenUpdating = False
＞For tuki = 1 To 12
・・・・・・・
・・・・・・・
＞Next tuki
＞Application.ScreenUpdating = True
＞End Sub

とLoopしている間は画面更新をしないようにしてみてはどうでしょうか？

※　これでも短縮されなかったらごめんなさいね。m(_ _)m

お礼

ありがとうございます。
やってみましたが、時間短縮は図れませんでした。

回答No.1

airhead-no1

Dim c As Range
For tuki = 1 To 12
の間に
Application.ScreenUpdating = False

Next tuki
End Sub
の間に
Application.ScreenUpdating = True

を入れてみるのはどうでしょうか？

お礼

ありがとうございます。
やってみましたが、時間短縮は図れませんでした。