グラフを連続的に高速で動かしたいです

質問

お世話になります。

しょうもない質問ですんで、お暇な方お願いします。

添付画像にあるようなグラフがあり、画面内のボタンを押すと

セルＢ３、Ｃ３の値が０から始まり、１きざみで１０００になるまで繰り返します。

Sub ボタン1_Click()

Dim i As Long
Dim s, e As Date

s = Now()

Range("b3").Value = 0
Range("c3").Value = 0

For i = 1 To 1000

Range("b3").Value = Range("b3").Value + 1
Range("c3").Value = Range("c3").Value + 1

DoEvents

Next

e = Now()

MsgBox CDate(e - s)

End Sub

このコードですと１０００まで繰り返すまでの時間が私のＰＣでは３４秒程掛っています。

コードの変更のみでこれを３秒ぐらいにできないでしょうか？

なお、DoEventsは入れてないとグラフの更新が表示されませんでした。

よろしくお願いします。

回答No.4

xls88 · ベストアンサー

セル書き込みを止めて直接グラフに値を渡す方法はどうでしょうか。

For i = 1 To 1000
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
.XValues = "{0," & i & "}"
.Values = "{0," & i & "}"
End With
Application.ScreenUpdating = True
Next

お礼

そんな方法があるんですね。

ありがとうございます。

試してみます！

回答No.5

DreamyCat

本来の高速描画の主旨とは違いますが
みかけだけ早くすることは可能です。

そのグラフ幅からかんがえると３００ポイント前後でしょうし、
グラフの線幅も2.25ポイントのようです。
１０００回繰り返すということは同じ線をおよそ６回ずつ書き換えているので
step 10 くらいにすればいいかと思います。

お礼

お礼が遅くなり申し訳ありません

ご回答ありがとうございます。

やっぱりステップを１０ぐらいにするのがいいですかね。

回答No.3

neKo_deux

> このコードですと１０００まで繰り返すまでの時間が私のＰＣでは３４秒程掛っています。
> コードの変更のみでこれを３秒ぐらいにできないでしょうか？

１秒あたりに描画する画面数、フレーム毎秒、fpsに直すと、

29.4fpsを333.3fpsにって話になります。

人間の目で見て滑らかに見えるのは20fps程度～です。
相当高速に動作するゲームでも60fps程度を目安にしています。
また一般的なディスプレイのリフレッシュレートは75Hzくらいです。

333.3fps、秒間に300枚描画を行なっても、表示されないし、表示されても認識できないので意味無いって事になると思います。

まずは、刻み幅を10くらいにしてみては？

処理自体は、特にいじるところ無いと思いますが。
１コマずつ画像作成して、動画にしてしまうとか？

お礼

回答ありがとうございます。

>１コマずつ画像作成して、動画にしてしまうとか？

それは私の技量では難しそうですね～

やっぱり刻みを変えるのがいいですかね～

回答No.2

okormazd

このままでは、グラフの描画で時間がかかるので、改善はできないと思います。
したがって、グラフ描画を適当に端折って、見た目それらしくするしかないと思います。
たとえは、Do Eventをいちいちやらずに、いくつか置きにしたらどうですか。

If i Mod 10 = 0 Then
DoEvents
End If

とするとか、10を適当な数にする。

お礼

回答ありがとうございます。

やっぱり更新回数の多さがネックですよね。

端折るしかないですかね

回答No.1

ki-aaa

ここに書いてあるプロセスでは、時間はかからないので
グラフの更新回数を減らすほか無いでしょう。

Sub ボタン1_Click()

Dim i As Long
Dim s, e As Date
s = Now()
Range("b3").Value = 0
Range("c3").Value = 0
Application.ScreenUpdating = False
For i = 1 To 1000
Range("b3").Value = Range("b3").Value + 1
Range("c3").Value = Range("c3").Value + 1
If (i Mod 20) = 0 Then ' 20回毎に
Application.ScreenUpdating = True
DoEvents
Application.ScreenUpdating = False
End If
Next
e = Now()
MsgBox CDate(e - s)

End Sub

これで望みどおりにいくといいんだけど。

お礼

回答ありがとうございます。

グラフの更新回数を減らすか

刻みを１０ぐらいにするか

しか方法はなさそうですね～

どれが一番早いか検証してみたいと思います。