このExcelマクロを効率化して実行速度を早くする方法を教えてください。

質問

Excel VBA 初心者です。
別の人が作成した次のマクロの処理速度が遅く困っています。
コードのあまり効率的ではない部分を修正して少しでも処理速度を早くしたいのですが、VBAを学びだして間がないため、どの部分に修正の余地があるのかよくわかりません。
恐れ入りますがアドバイス等いただけませんでしょうか？

Sub Record126()

With Application
.ReferenceStyle = xlR1C1
End With

Dim MOTOGYOU As String
Dim HENKOUGYOU As String
'最大階数及び最大列数検出
Sheets("立面図").Select
Range("A2:CH627").Select
Selection.ClearContents
Selection.MergeCells = False
Selection.Borders(xlLeft).LineStyle = xlNone
Selection.Borders(xlRight).LineStyle = xlNone
Selection.Borders(xlTop).LineStyle = xlNone
Selection.Borders(xlBottom).LineStyle = xlNone
Selection.BorderAround LineStyle:=xlNone
Range("C4").Select
Sheets("立面作業").Select

回答No.8

Wendy02 · ベストアンサー

こんにちは。
#6 のWendy02です。

私も最近覚えたことで、#6 で書かれた「3.」 とも関係のあることですが、モジュール自体を分散化するとよいということです。(ここらのレベルになると、はるかに高度な技術になってきます。)実行するときに、モジュール全体をメモリの中に取り込むので、それで分散させるということです。

＞5. VBAの式の入力と式の表現とは別物」については、うまく理解できていないのか、修正すると最後のほうの置換処理がうまくできませんでした。

それは、式自体を逆に換えなくてはならないからではないでしょうか？
もし、R1C1方式が慣れているなら、それはそれで問題ないのですが、いずれにしても、式を書き込むマクロは、問題の種を撒いているようなものです。

式を置きながら、メモリの使用を増やしていくわけです。私が調べたところでは、ワークシートとモジュールの二重の負担なるようなのです。まして、#7さんのご指摘の Calculate は、それを致命的な状態にさせます。

私が何度言っても理解しない人もいるのですが、VBAは、スクリプトだっていうことです。コンパイルされた言語じゃないということで、不必要なものは全部省略したって構わない、文字数自体を減らすことですね。ただし、Range("A1") とCells(1,1)とどちらが速いかつていったら、Cells のほうで、Cells(1,"A") は、それに順じます。

塵も積もれば山となりますから、用心に越したことはありません。

それと、私は、一応、その問題点は熟知しているつもりです。ソースをみて一目で分る部分があります。しかし、それを直すのは容易なことではありません。初めから書き直さないとダメなことも往々にしてあります。

お礼

お返事がたいへん遅くなりすみませんでした。
どうもありがとうございました。

回答No.7

papayuka

このソースだけでは遅い理由を特定出来ないと思います。
推測でしかありませんが、大量の関数又は複雑な計算関数を使ってませんか？

結果に影響がないなら、 Calculate をコメントアウトしてみては？

お礼

お返事が大変おそくなり申し訳ございませんでした。
どうもありがとうございました。

回答No.6

Wendy02

こんにちは。

コードの最適化には、まとめる場所のポイントと注意点を書いていきますので、ご自身で考えてください。人によってはしてくれる人もいますが、私は、全てのコードを出していただいても、最適化の自体のお手伝いはいたしませんので、予めご了承願います。

ざっと思いついたところから、箇条書きしておきます。

1.罫線は、Clear や ClearFormats を使用する。

Range("A2:CH627").ClearFormats
Borders.LineStyle とか、 MergeCell とかは、以上で消せますが、ClearContentsもあるなら、

Range("A2:CH627").Clearなら、全てが消えます。

2. Select は、必要以上にしないこと。

Range("F1").Select
ActiveCell.FormulaR1C1 = "=MAX(R[1]C:R[530]C)"
Range("F1").Select
Selection.AutoFill Destination:=Range("F1:G1"), Type:=xlFillDefault
Range("F1:G1").Select

は、
単に、
　Range("F1:G1").FormulaR1C1 = "=MAX(R[1]C:R[530]C)"
だけで十分なはずです。

式は、予め入れておいてもよいはずです。新規からシートを作り始めるなら分りますが、そうでないのなら、規定のものは、すでに入れておきます。

Application.MaxChange = 0.001
これは、グローバルな設定は個別のマクロでは指定しません。
手動で設定してください。

また、以下のような場合は、

Range("F2").Select '最初の行の階数を絶対指定で選択
KONOR = ActiveCell.ROW
KONOC = ActiveCell.Column

　↓

'最初の行の階数を絶対指定で選択
With Range("F2")
KONOR = Range("F2").ROW
KONOC = Range("F2").Column
End With

となります。

3.コードは、処理ユニットごとに別けて、Call プロシージャ名　で飛ばす。
一度に、コードをまとめてはいけません。

例:
Sub Main()
　Call Test1
　Call Test2
End Sub

Sub Test1
　'実行
End Sub
Sub Test2
　'実行
End Sub

4.コンテナ処理をすること。
コンテナ処理のほうがスピードが速いのと、Select しなくて済む。
そのためには、With ステートメントが必要になります。
With Sheets("立面作業")
　.Range("F1:G1").FormulaR1C1 = "=MAX(R[1]C:R[530]C)"
End With

この場合、シートのSelect が必要ありません。Rangeオブジェクトの前に、「.」（ピリオド）が入ります。

5. VBAの式の入力と式の表現とは別物
With Application
.ReferenceStyle = xlR1C1
End With

R1C1方式であろうがA1方式であろうが、VBAコードで、1つの式のスタイルで入力をするということで、.FormulaLocal　でA1方式で入力しても、論理的には同じことです。

6.　値を入れるときは、右辺と左辺を同じValueプロパティで、配列渡しにする。

Range("F1:G1").Select
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F1").Select

これは、単に、配列を使って入れなおすだけです。
Range("F1:G1").Value = Range("F1:G1").Value

7.不必要なプロパティは削除する

この場合、ActiveCell は曖昧だから、セルは決めなくてはなりません。
ActiveCell.Range("A1:B6").Select
Selection.Borders(xlLeft).LineStyle = xlNone
Selection.Borders(xlRight).LineStyle = xlNone
Selection.Borders(xlTop).LineStyle = xlNone
Selection.Borders(xlBottom).LineStyle = xlNone
Selection.BorderAround Weight:=xlMedium, ColorIndex:=xlAutomatic
Selection.HorizontalAlignment = xlRight
Selection.ShrinkToFit = True

　　↓
With Sheets("立面図").Cells(UGOKUY, UGOKUX).Resize(6, 2)
　.BorderAround Weight:=xlMedium, ColorIndex:=xlAutomatic
　.HorizontalAlignment = xlRight
　.ShrinkToFit = True
End With

最後に、これだけを一度にまとめようとしても、ミスを誘発するだけですから、まず、上記の３で書いたように、コード自体を各々のプロシージャーに分割してください。それから作業をしてください。

お礼

ありがとうございます。

ほかの質問も含め丁寧にお答えいただき大変助かりました。

＞まとめる場所のポイントと注意点を・・・

このようなかたちでお教えいただくほうが勉強になります。ありがとうございます。

お教えいただいたことを試行錯誤してコードを大幅に修正しました。その作業に時間がかかったためお礼が遅れました。申し訳ありません。

「5. VBAの式の入力と式の表現とは別物」については、うまく理解できていないのか、修正すると最後のほうの置換処理がうまくできませんでした。

教えていただいた内容でコードを効率化した結果、処理が若干早くなりました。
しかし、やはり、処理が重過ぎるのはそのままです。「処理が遅いのはコードの非効率ではなく、ファイルサイズが大きすぎるため？」かもしれません。現在のファイルサイズが30Mくらいあるのです。仮に直接関係ないシートを削除してファイルサイズを4M位にすると
、処理時間50分程度の作業が5分程度でできました。
直接関係ないシートも実際には削除・別ブック化できないのでこれはこれで困るのですが・・・

それはさておき、本当にどうもありがとうございました。とても勉強になりました。

回答No.5

noname#223623

まだまだコードが続きそうですね。補足欄確保のためにもちょっとアドバイスします。

質問者様のお悩みとしては次の2点があると思います。
　1. どこが遅いかわからない
　2. どうすれば速くなるかわからない
初心者の場合、2は難しいかもしれませんが、1に関してはある程度絞り込むことができます。次にその方法を書きます。

まず、全体をいくつかのブロックに分割します。
　'ブロックA
　Range("A2:CH627").Select
　(略)
　'ブロックB
　Sheets("立面作業").Select
　(略)
　'ブロックC
　Sheets("立面図").Select
　(以下略)

次に各ブロックの処理にどれくらいの時間がかかっているか調べます。各ブロックの最初と最後に1行ずつ追加します。
　'ブロックA
　Debug.Print "ブロックA START " & Now ' <- ここに追加
　(この間は現在のコード)
　Debug.Print "ブロックA END " & Now ' <- ここに追加

これでブロックの処理開始時間と、処理終了時間が出力されますので、一番時間のかかっているブロックが特定できます。それをさらに分割して(ブロックA-1、ブロックA-2という感じ)、同じように時間を表示させれば、どこが遅いのかは大体わかってきます。ちなみにDebug.printの結果はイミディエイトウインドウに出力されるので、ウインドウを表示していなかったら、表示させてください(方法は参考URL)。

このようにすれば、投稿する際にも問題のある部分だけを出せばいいので、質問者、回答者ともに手間がかからなくて良いのではないでしょうか。その分、回答も早くなるでしょうし、より的を得たものになると思います。

回答でもないのに長くなって申し訳ありませんでした。ただ、これはデバッグの基本的なことなので、お役にたてるかなと思って書きました。

参考URL：

http://www.ken3.org/vba/iwind.html

お礼

ありがとうございます。
勉強になります。

今回の処理の場合、どこが遅いではなく、全部が遅いようです。
画面を見ていても一つ一つの行の処理が1秒近くかかっているのがわかります。

コードの書き方の問題ではなく、ファイルの大きさの問題かなと・・・

今後の参考にさせていただきます。
どうもありがとうございました。

回答No.4

meron_

ちなみに・・・
C:\WINDOWS\TEMP フォルダの中にゴミが溜まっている場合があります。
以下の手順で削除して下さい。

１．起動中のプログラムを全て終了して下さい。
２．Tempフォルダ内の*.emfファイルを全て選択して削除

注意・・Tempフォルダを削除しないで。
注意・・削除するときにメッセージが出て、削除できない場合は無理に消さなくてもいいです。

以下他サイトより引用
==============================================================
*.emfが溜まると、起動するのに時間がかかる事になります。
*.emfはマクロなどを含むexcelを立ち上げる時に一時的に大量
に作成されるファイルです。正常に終了した場合には、全て自動で
削除されますが、強制終了などがあるとそのまま残ってしまい不具
合の元になってしまいます。
TempフォルダはExcel以外でも使用しています。
Tempフォルダ内のファイルはコマメに削除して下さい。
==============================================================

お礼

恐れ入ります。
.emfファイルは今のところ残っていませんでした。でも、今後気をつけておきたいと思います。
本当にありがとうございます。

コード続き（最後）です。長々と申し訳ありません。
ActiveCell.Offset(-3, 1).Range("a1").Select
Selection.HorizontalAlignment = xlLeft
ActiveCell.FormulaR1C1 = "m2"
ActiveCell.Offset(2, 0).Range("A1").Select
Selection.HorizontalAlignment = xlLeft
ActiveCell.FormulaR1C1 = "円"
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.HorizontalAlignment = xlLeft
ActiveCell.FormulaR1C1 = "円/m2"

ActiveCell.Offset(-5, -1).Range("A1").Select

'置換
MOTOGYOU = "R100"
Range(Cells(UGOKUY, UGOKUX), Cells(UGOKUY + 5, UGOKUX)).Select
HENKOUGYOU = "R" & KONOGYOU
Selection.Replace What:=MOTOGYOU, Replacement:=HENKOUGYOU, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ActiveCell.Offset(0, 2).Range("A1").Select
Count = Count + 1
'置換終了
Sheets("立面作業").Select
KONOR = KONOR + 1
Cells(KONOR, KONOC).Select
If ActiveCell.Value = 0 Then
GoTo lastline
Else
GoTo line1
End If
lastline:
Sheets("立面図").Select
Range("A1").Select

With Application
.ReferenceStyle = xlA1
End With

End Sub

回答No.3

meron_

これも加えてみて。。
Application.EnableEvents = False '一時的にイベントを無効にする
Application.Calculation = xlManual '計算方法を手動に

'===============

Application.Calculation = xlAutomatic '計算方法を自動に
Application.EnableEvents = True 'イベントを有効にする

お礼

何度もありがとうございます。
追加してみたところ、感覚としてわかるくらい早くなりました。たぶん処理時間60分が40分くらいにはなったと思います。
助かりました。ありがとうございます。

コード続き（その3）です。
長ったらしくてすみません。

ActiveCell.Offset(1, 0).Range("A1:b1").Select
Selection.HorizontalAlignment = xlHAlignCenterAcrossSelection
Selection.MergeCells = True
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "=IF(ROW(MAIN!r100C11)=MAIN!R5C3,""＜基準＞"",IF(ROW(MAIN!R100C11)=MAIN!R8C3,""＜基準＞"",IF(ROW(MAIN!R100C11)=MAIN!R11C3,""＜基準＞"",IF(MAIN!R100C69=MAIN!R721C69,""最低"",IF(MAIN!R100C69=MAIN!R722C69,""最高"","""")))))"
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.NumberFormat = "#,##0_ "
ActiveCell.FormulaR1C1 = "=MAIN!R100C69" '家賃
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.NumberFormat = "#,##0_ "
ActiveCell.FormulaR1C1 = "=MAIN!R100C69/MAIN!R100c11" '単価

回答No.2

meron_

ちなみに質問者さんの動作環境がわかれば教えてください。
・OS
・Excelのバージョン
・PCのCPU、メモリ　・・・など

お礼

OS　WinXP Pro SP1
Excel 2003 SP1
CPU Celeron1.2G
メモリ　376M

です。会社のパソコンですのであまり性能は良くないのですが、自宅のパソコン（Pen4 3.2G RAM1G) で処理しても気持ち程度早くなったかな・・・という程度です。（処理時間1時間が55分とかいう程度）

お手数をおかけしてすみません。

コード続き（その２）です。たびたびすみません。

'箱作
Sheets("立面図").Select
ActiveCell.Range("A1:B6").Select
Selection.Borders(xlLeft).LineStyle = xlNone
Selection.Borders(xlRight).LineStyle = xlNone
Selection.Borders(xlTop).LineStyle = xlNone
Selection.Borders(xlBottom).LineStyle = xlNone
Selection.BorderAround Weight:=xlMedium, ColorIndex:=xlAutomatic
Selection.HorizontalAlignment = xlRight
Selection.ShrinkToFit = True
ActiveCell.Range("a1:b1").Select
Selection.HorizontalAlignment = xlHAlignCenterAcrossSelection
Selection.MergeCells = True
Selection.NumberFormat = "0_ "
ActiveCell.FormulaR1C1 = "=MAIN!R100C9" '号室
ActiveCell.Offset(1, 0).Range("A1:b1").Select
Selection.HorizontalAlignment = xlHAlignCenterAcrossSelection
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "=MAIN!R100C33" '型式
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.NumberFormat = "0.00_ "
ActiveCell.FormulaR1C1 = "=MAIN!R100C11" '面積

回答No.1

meron_

とりあえず

作業前に
Application.ScreenUpdating = False　して
作業終了後
Application.ScreenUpdating = True　に戻す

参考URL載せておきます

参考URL：

http://www.officetanaka.net/excel/vba/speed/s1.htm

お礼

ありがとうございます。
ScreenUpdatingは少し考えたのですが、これをすると1時間近く処理が進んでいるのかフリーズしているのか確認できなくなってしまうので・・・
ありがとうございます。

コード続き（その1）です。（文字数制限があるので・・・すみません）

Range("F1").Select
ActiveCell.FormulaR1C1 = "=MAX(R[1]C:R[530]C)"
Range("F1").Select
Selection.AutoFill Destination:=Range("F1:G1"), Type:=xlFillDefault
Range("F1:G1").Select
Range("F1").Select
Application.MaxChange = 0.001
ActiveWorkbook.PrecisionAsDisplayed = False
Calculate
Range("F1:G1").Select
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F1").Select
YMAX = ActiveCell.Value '最大階数
XMAX = ActiveCell.Offset(0, 1).Value '最大列数
Sheets("立面図").Select
UEY = 6 '左上階数
HIDARIX = 5 '左上列数
Cells(UEY, HIDARIX).Select
Sheets("立面作業").Select
Range("F2").Select '最初の行の階数を絶対指定で選択
KONOR = ActiveCell.ROW
KONOC = ActiveCell.Column
line1:
Sheets("立面作業").Select
Cells(KONOR, KONOC).Select
KONOY = ActiveCell.Value '最初の行の階数
KONOX = ActiveCell.Offset(0, 1).Value '最初の行の列数
KONOGYOU = ActiveCell.Offset(0, -5).Value '最初の行のメインシートでの行数
UGOKUY = (YMAX - KONOY) * 6 + UEY
UGOKUX = (XMAX - KONOX) * 2 + HIDARIX
Sheets("立面図").Select
Cells(UGOKUY, UGOKUX).Select '最大階を６、最大列を５とした場合の１行目のＸＹ座標を計算して、セルを選択