エクセルマクロで計算すると遅い

質問

エクセル2013です。
表に対して、いろいろな処理を行い
要求された結果になるようにマクロを作成し完成しました。
思ったように動作するのですが処理時間が長すぎます。
自分で調べて、以下の部分が処理を遅くしている原因とわかりました。
ただの計算ですが、シート内に計算式や関数は残したくなくて
このようにしましたが、別の方法が浮かびません。
どのような方法が有りますでしょうか？
よろしくお願いします。

表は600行、50列。
17列目から49列目までの10行目から595行目までにデータがあります。
50列目は合計値用の空欄です。8行目は項目欄です。
インプットボックスは18～48までしか入力できないようにしてあります。
17列目からインプットボックスで入力した列までの合計値を
インプットボックスで指定した列のひとつ前の列に1行づつ処理して転記。
17列目からインプットボックスで指定した列の1列前までまとめて列削除
その後17列目から削除され残った最終列の1列前までの合計値を最終列に転記で
1行づつ処理です。

最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得
最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得
遅延合計欄列 = 選択列 - 1 'INPUT-BOXで選択した列の1列前の列番号を格納。この列に合計値を転記する為
遅延合計末列 = 選択列 - 2 'INPUT-BOXで選択した列の2列前を格納。ここまでの列を削除する為
Cells(8, 遅延合計欄列).Value = "遅延" 'INPUT-BOXで選択した列の1列前の列の8行目を「遅延」と転記しこの列に合計を転記する
Cells(8, 遅延合計欄列).Font.Color = -16776961
Cells(8, 遅延合計欄列).Font.Size = 15
Range(Cells(10, 遅延合計欄列), Cells(最終行, 遅延合計欄列)).Interior.Color = 65535

For 計算行 = 10 To 最終行 '10行目から最終行まで繰り返す
'17列目からINPUT-BOXで選択した列の1列前の列までの合計値を1列前の列に転記する。10行目から最終行まで
Cells(計算行, 遅延合計欄列).Value = WorksheetFunction.Sum(Range(Cells(計算行, 17), Cells(計算行, 遅延合計欄列)))
Next 計算行

Range(Columns(17), Columns(遅延合計末列)).Delete '17列目からINPUT-BOXで選択した列の2列前までを列削除

最終列2 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得
最終行2 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得

For 合計行 = 10 To 最終行2 '10行目から最終行まで繰り返す
'17列目から最終列の1列前までの合計数数を最終列に転記
Cells(合計行, 最終列2).Value = WorksheetFunction.Sum(Range(Cells(合計行, 17), Cells(合計行, 最終列2 - 1)))

Next 合計行

回答No.1

mitarashi · ベストアンサー

VBAの速度に不満を覚える様になった場合、一番効果的なのはセルから配列に読み込んで、配列に対してデータ処理を行い、片が付いてからセルに書き戻す事です。
下記100万回の足し算のループで、セル間の演算だと130000msec弱、メモリ上の演算だと46msecと2800倍も速度に差がありました。(Core i5, 3.2GHz, Win7Home-64bit,Xl2010-32bit環境)
後は、行の切った貼ったを行うと更に時間がかかりますので、別のシートに必要な部分だけを抽出する事で同様の効果を得る事ですね。
今回のデータに具体的にどう適用可能かは読み解く元気が無いのであしからず。
Declare Function GetTickCount Lib "kernel32" () As Long

Sub test1()
Dim i As Long
Dim startTime As Long

startTime = GetTickCount
For i = 1 To 1000000
Cells(1, 3).Value = Cells(1, 1).Value + Cells(1, 2).Value
Next i
Debug.Print GetTickCount - startTime
End Sub

Sub test2()
Dim i As Long
Dim v1 As Variant, v2 As Variant, v3 As Variant
Dim startTime As Long

v1 = Cells(1, 1).Value
v2 = Cells(1, 2).Value
v3 = Cells(1, 3).Value
startTime = GetTickCount
For i = 1 To 1000000
v3 = v1 + v2
Next i
Debug.Print GetTickCount - startTime
End Sub

お礼

配列はむずかしくて使用経験が
ありません。
NETで調べて挑戦してみます。
ありがとうございました。

回答No.3

mt2008

提示されたコードの外でやっているかもしれませんが、
処理の前に
Application.ScreenUpdating = False

処理の最後に
Application.ScreenUpdating = True

無駄な画面描画を押さえて最後に更新させているだけですが、これで結構変わると思いますよ。

お礼

はい、やっています。
ありがとうございます。

回答No.2

K Kazz（@JazzCorp）

ノウミソを弱酸性の溶液でセンジョウすべし、、、

お礼

ありがとうございました