VBA初心者の高速化マクロ修正

質問

• VBA初心者が作成した修正済みの高速化マクロ
• セルのフォント色、背景色、罫線設定を一括で行う
• 問題数に応じてセルの設定を変更し、印刷範囲を指定する

回答No.7

fumufumu_2006

質問のプログラムの各処理にがかかる時間を表示します。
最初のApplication.ScreenUpdatingは、ある場合と無い場合で違いを見てください。
特に時間がかかっている処理が無くてApplication.ScreenUpdatingのある場合が早いなら、何か全体を遅くしている表示関係の処理があるので、新たなブックに作り直すのが一番いいと思います。

'Application.ScreenUpdating = False '実行する場合としない場合でトータル時間の差を見る
Dim msg As String
Dim t As Single
Dim tt As Single
tt = Timer
t = Timer
Range("C3:E22,H3:J22").Select
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = 2
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
' ここまでは、共通の動作
msg = msg & "ここまでは、共通の動作=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("A1").Select
ActiveCell.FormulaR1C1 = "20"
' 問題数に応じて、数字を変更
msg = msg & "問題数に応じて、数字を変更=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("C3:E22,H3:J22").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' 罫線を引く
msg = msg & "罫線を引く=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("D3:E22,I3:J22").Select
Selection.Font.ColorIndex = 1
' 文字を黒くする
msg = msg & "文字を黒くする=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("C3:C22,H3:H22").Select
Selection.Interior.ColorIndex = 16
' セルをグレーにする
msg = msg & "セルをグレーにする=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Rows("3:18").Select
Selection.RowHeight = 31.5
' セルの幅を指定
msg = msg & "セルの幅を指定=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
ActiveSheet.PageSetup.PrintArea = "$B$1:$K$25"
' 印刷範囲を指定
msg = msg & "印刷範囲を指定=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("U3:U42").Select
Selection.ClearContents
' 四線を消去
msg = msg & "四線を消去=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
Range("D3:D4").Select
Calculate
' 再計算完了
msg = msg & "再計算完了=" & Format(Timer - t, "0.00") & vbCrLf: t = Timer
msg = msg & "TotalTime=" & Format(Timer - tt, "0.00")
Application.ScreenUpdating = True
MsgBox msg

補足

教えていただいたものを新しいブックで試した結果、
両方とも差はありませんでした。
また、偏って時間がかかることもありませんでした。
自分が作ったサンプルをのせたので、見てもらえますか？
http://briefcase.yahoo.co.jp/bc/add0804/lst?.dir=/%a5%de%a5%a4%a5%c9%a5%ad%a5%e5%a5%e1%a5%f3%a5%c8