みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBAで計算を速くできるプログラムは他にありますか

自己流で書いたのですが、(以下でも答えは合ってはいるのですが、計算結果が出るのが遅いので、もっと速くできるにはどのように書けば良いでしょうか?ご存知の方教えて下さい。

Sub 計算()
Dim i, g, u, m, X, A As Integer
i = 15

Do Until i = 231

Select Case Cells(i, 1)

Case "S"
Cells(i, 11) = Cells(i, 5) * Cells(i, 9)
Cells(i, 13) = Cells(i, 5) * Cells(i, 9)
Cells(i, 14) = 0

Case "R"
Cells(i, 11) = Cells(i, 5) * Cells(i, 9)
Cells(i, 13) = 0
Cells(i, 14) = Cells(i, 5) * Cells(i, 9)

Case "MT"
Cells(i, 11) = Cells(i, 5) * Cells(i, 7) * Cells(i, 9)
Cells(i, 13) = Cells(i, 5) * 1 * Cells(i, 9)
Cells(i, 14) = Cells(i, 5) * 1 * Cells(i, 9)

Case ""
Cells(i, 11) = ""
Cells(i, 13) = ""
Cells(i, 14) = ""
End Select

i = i + 1
Loop

i = 15
g = 15
u = 15


Do Until Cells(5, g) = ""
For u = 15 To 231
If Cells(u, 1) = "S" Or Cells(u, 1) = "R" Or Cells(u, 1) = "B" Or Cells(u, 1) = "T" Then
Cells(u, g) = 0
End If
If Cells(u, 1) = "MT" Then
Cells(u, g) = Cells(u, 5) * 1 * Cells(u, 9)
End If
If Cells(u, 1) = "D" Then
Cells(u, g) = Cells(u, 5) * Cells(5, g) * Cells(u, 9)
End If

Next u

g = g + 1
Loop

u = 15
m = 13

Do Until Cells(10, m) = ""

For u = 15 To 231

If Cells(u, 1) = 0 Then

Cells(u, 11) = Cells(u, 9)
Cells(u, m) = Round(Cells(u, 9) * Cells(10, m), 0)
End If

Next u

m = m + 1
Loop

i = 15
X = 15
For i = 15 To 231
If Cells(i, 11) < 0 Then
Cells(i, 14).ClearContents
End If
Next i
For i = 15 To 231

If Cells(i, 11) < 0 Then
Do Until Cells(i, X) = ""
' A = Cells(i, 14)
Cells(i, 14) = Cells(i, X) + A
A = Cells(i, 14)

X = X + 1
Loop

Cells(i, 14) = Cells(i, 11) - Cells(i, 13) - Cells(i, 14)
End If

X = 15
A = 0
Next i

End Sub

投稿日時 - 2013-01-04 16:06:15

QNo.7875144

すぐに回答ほしいです

質問者が選んだベストアンサー

どんなデータの何をどうしたいコードなのかわかりませんので、
コードを拝見した感想だけ。


とりあえず、処理を早くしたいのであれば、
無駄なループをなるべく減らすのが一番の近道、と言うのが印象です。
例えば、
~引用開始~
i = 15
X = 15
For i = 15 To 231
If Cells(i, 11) < 0 Then
Cells(i, 14).ClearContents
End If
Next i

For i = 15 To 231
If Cells(i, 11) < 0 Then
Do Until Cells(i, X) = ""
' A = Cells(i, 14)
Cells(i, 14) = Cells(i, X) + A
A = Cells(i, 14)
X = X + 1
Loop
Cells(i, 14) = Cells(i, 11) - Cells(i, 13) - Cells(i, 14)
End If
~引用終了~
この部分ですが、
15行目から231行目までCells(i, 11)が0未満だったら、
Cells(i, 14)を「消去」と「Do~Loop」を別々に行っていますが、
これは同時に出来るはずです。
これだけでも、トータルの処理速度は少々早く出来ます。
(同じセルに対する処理が半分で済むのですから、単純に半分ですね。
 厳密に言うと、なかなかそうはいきませんが。)

さらに同じ部分ですが、Do~Loopの中の処理。
これはアレですか?
i行の15列目からデータがある範囲の合計を出したい、と言う処理ですか?
だとしたら、単純にWorksheetFunction.Sumなどで一発で処理できそうな気がします。
これでループが一つ減りますから、ここだけでもそれなりに時間短縮が出来そうです。

さらにさらに、For i = 15 To 231 で、iは15から、と言う定義が出来ますから、
引用部冒頭の「i=15」の代入は不要ですね。
これは、随所に見られます。



あと、コード冒頭の
Dim i, g, u, m, X, A As Integer
この変数を宣言する部分ですが、おそらく「これら全てInteger型だよ」のおつもりでしょう。
ですが、これだと変数A以外はバリアント型(Variant)で宣言したようにとられてしまいます。
正しくは、
Dim i As Integer, g As Integer,・・・, A As Integer
のように、全てにおいて「As Integer」が必要です。
で、このバリアント型は、整数型より格段に処理が遅いです。
これも、速度に影響が出ている要因の一つと言えるかもしれません。


などなど、無駄なループ処理や代入を減らせば、少しずつ早くなっていくと思いますよ。



最後にもう一つ、余計なお世話を重ねますが、
処理の速さにこだわるなら、
繰り返し処理はDo~LoopよりFor~Nextの方が少々早いですよ。
> i = 15
> Do Until i = 231
> i = i + 1
> Loop
のように繰り返しの上限が決まっているなら、
  For i = 15 To 231
をオススメします。

投稿日時 - 2013-01-05 15:03:38

お礼

基本が良く分かっていないので、ご指摘のとおりだと思います。
大変勉強になりました。
できるかどうか試してみます。

投稿日時 - 2013-01-06 00:28:58

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

ANo.1で十分そうですね。更に気をつけるならANo.2。そしてもっと細かい話をすると、IntgerよりLong、OrよりIfネスト、CaseよりIf・・・ってどーでもいいヨネ。
出番か!と思ったのに(・ε・)

余計ですが、以下説明。#補足なのでベストにはしないで

ExcelVBAが遅くなる最大の原因がセルアクセスです。他にも高速化テクはあるけど影響わずかなので、興味あれば「VBA 高速化」で検索してください。
セルのよーなオブジェクトへのアクセスは内部で細々と処理が走り、特に、セルへの書き込みは毎回"全セルが再計算"されるため、計算式が多いと一晩かかることも。
なのでANo.1のように、まとめて読み込みまとめて書き出すのがベスト。Resizeで範囲を指定すると2次元配列で値のみ取得でき、逆の手順で書き出せます。
ClearContentsの箇所は、MyCells(i,14)=Emptyで。

投稿日時 - 2013-01-05 19:41:55

お礼

MyCells(i,14)=Empty

使わせていただきます。
有難うございました。

投稿日時 - 2013-01-06 01:42:03

ANo.1

1.
CellsをすべてMyCellsに置換する
2.
Sub 計算()の次に
MyCells = Cells(1, 1).Resize(231, 100)
を入れる。
3.
End Subの前に
Cells(1, 1).Resize(231, 100) = MyCells
を入れる。

ただし2.と3.で使っている
(231, 100)
は,適当に使いそうな大きさの値にしてください。行は231行までを対象にしているようだが,列は最大でどこまで使うのかわからないから適当に100にしています。

投稿日時 - 2013-01-04 18:45:31

あなたにオススメの質問