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
お礼
どうもありがとうございました。 感激です。