処理を早くできませんか？

質問

お世話になります。
職場で日報をエクセルで作成していて運用してから1年になります。
先日1年となったので、さらに
Sub ERS()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = ("入力の全てが消去されます。") & Chr(13) & ("よろしいですか？") & Chr(13) & ("処理には相当時間必要です。") Style = vbYesNo + vbExclamation + vbDefaultButton2 Title = "消去の確認" Help = "DEMO.HLP" Ctxt = 1000 Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then
GoSub kesu
Else Exit Sub
End If

kesu:

For i = 2 To 5200 Step 14
For j = 3 To 12

ActiveSheet.Range("F" & i + j) = ""
ActiveSheet.Range("G" & i + j) = ""
ActiveSheet.Range("H" & i + j) = ""
ActiveSheet.Range("I" & i + j) = ""
ActiveSheet.Range("J" & i + j) = ""
ActiveSheet.Range("k" & i + j) = ""
Next j
Next i

End Sub

というものを作成して、フォーマットの初期化（入力を全て消す）をするようにしました。
しかし、このモジュールでは、処理速度がかなり遅く、数日分の消去にかかった時間から計算すると1年分に130分かかってしまいます。
PCのスペックによるものとはおもいますが、上記のモジュールを書き換えて早く処理できるものなら。。と思い、書き込みさせていただきました。
よろしくご教示願います。
ちなみにOSはWIN2000、EXCEL2002、PCはクロック800MHZです。

回答No.2

Wendy02 · ベストアンサー

こんばんは。

私も、ためしに作ってみました。
MsgBox の凝った造りのわりに、肝心なところをもう少し工夫したほうが良かったですね。元のコードを作る時の集中力があれば、おそらくは、簡単にできただろうに……？？

ところで、PCのスペックは、Excelのデモでは、こんなに早いですと、PC画面の比較が出ますが、比較すると思ったほど変わらないような気がしますね。画面表示に関しては差があるようですが、それは、ScreenUpDating でとめてしまえばよいですからね。

Sub ClearData()
　　Dim Msg As String, Style As Integer, Title As String, Help As String
　　Dim Ctxt As Integer, Response As Integer, MyString As String
　　Dim bRng As Range
　　Dim i As Long

　　Msg = "入力の全てが消去されます。" & vbCrLf & "よろしいですか？"
　　Style = vbYesNo + vbExclamation + vbDefaultButton2
　　Title = "消去の確認"
　　Help = "DEMO.HLP"
　　Ctxt = 1000
　　Response = MsgBox(Msg, Style, Title, Help, Ctxt)

　　If Response = vbNo Then Exit Sub
　　Application.ScreenUpdating = False　'←ここが大事
　　With ActiveSheet
　　Set bRng = Range("F5:K14")　'ベース
　　For i = 0 To (5200 \ 14) + 1
　　　　bRng.Offset(i * 14).ClearContents
　　Next i
　　End With
　　Application.ScreenUpdating = True
　　Set bRng = Nothing
End Sub

お礼

お礼が遅くなりすいません。ご丁寧にご教示いただきありがとうございます。今後ともよろしくお願いします。

回答No.1

hana-hana3

＞ActiveSheet.Range("F" & i + j) = ""

時間が掛るの当然ですね。
範囲を決めて一括で消去する方が何倍も早いですよ。

Dim Msg, Help, Response, i
Msg = ("入力の全てが消去されます。") & Chr(13) & ("よろしいですか？")
Help = "DEMO.HLP"
Response = MsgBox(Msg, vbYesNo + vbExclamation + vbDefaultButton2, "消去の確認", Help)

If Response = vbYes Then
For i = 2 To 5200 Step 14
Range("F3:K12").Offset(i).ClearContents
Next i
End If

お礼

お礼が遅くなりすいません。
範囲指定で消去をする方法は気づいてましたが、手法がわかりませんでした。今後ともよろしくお願いします。