Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : その他)
動くグラフの作り方 BarChartRaceをエクセルで VBAで動くチャート
投稿日時: 21/11/01 17:05:01
投稿者: match13

使用環境
MacBook Pro (Retina, 13-inch, Mid 2014)
OS boot camp の ウィンドウズ10 pro
Excel Office Professional Plus 2019
 
やりたいこと
下記の動画のような、動く棒グラフを「エクセルで作りたい」
https://www.youtube.com/watch?v=xr56-DxUl08
外部サービスを使用できないので、自分PCのエクセルのみで、#BarChartRace を再現したいです。
 
アニメーションではなく、
@10行1000列程度の店舗(10行)ごとの売上数値(月次1000列)を棒グラフで動かしたいです。
Aまた、最初の1列目からの差分を折れ線グラフで表示し、これも自動で変化させていきたいです。
 
自分なりにプログラムを組んでみたのですが、@の時点で、グラフの再生速度を調整できず困っています。
Aは手つかず。
 
プログラムは下記の通りです。
一番下の「問題点」で動画の再生速度を調整しようとしているので、3通りやって、3通りともうまくいきません。
アドバイス、よろしくお願い致します。
 
#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
 
Sub 折れ線グラフ()
Dim i, p, q As Long
Dim chrt As Shape
Dim wait_sec As Double
 
wait_sec = 0.1
 
'チャートからループで直前に描写したグラフを削除するためのプログラム
Dim ChrtObj As ChartObject
'変数宣言 削除する系列を格納する変数
Dim deleteTarget As Integer
'前回の表示分である1列目を指定
deleteTarget = 1
 
 
'[A]すでにグラフがある場合は削除
For Each chrt In ActiveSheet.Shapes
    chrt.Delete
Next chrt
 
'[B]空のグラフを作成
' データ系列が設定されてしまった場合は削除
ActiveSheet.Shapes.AddChart.Chart.ChartType = xlColumnClustered
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.ClearContents
 
 
 
'[C]データ系列数と各系列のデータ数を検出
p = Range("B2").End(xlDown).Row - 2
q = Range("B2").End(xlToRight).Column
 
'MsgBox "確認"
 
 
'[D]データ系列数だけ繰り返し
For i = 1 To p
 
 
 
'[E]グラフにデータ系列を作成
    ActiveSheet.ChartObjects(1).Chart.SeriesCollection.NewSeries
 
 
 
'ループの2周目以降、iが2以降、前回描写したチャートを削除
    If i > 1 Then
        ActiveSheet.ChartObjects(1).Chart.SeriesCollection(deleteTarget).Delete
    End If
 
'[F]データ系列の設定を行う
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
        .ChartType = xlLine '折れ線グラフに設定
        .XValues = Range(Cells(1, 1), Cells(1, q)) '横軸の値を設定
        .Values = Range(Cells(2 + i, 2), Cells(2 + i, q)) 'データを設定
        .Name = Cells(2 + i, 1) '系列名を設定
    End With
     
     
    DoEvents
 
 
'問題点?
' スリープさせるとOSの処理は止まるが、Excelの処理は動いており、行が何行分か飛びながらカクカクで再生される。Application.Waitだと、数十秒後に、最後の結果だけが表示される。
'描画速度を調整したいが、以下の3通りでうまくいかない
 
'速度調整:1番 3〜10個ごとに数値が表示され、
    Sleep 100
     
'速度調整:2番 途中経過が表示されず、何十秒後かに最後の行のグラフだけが表示される
' Application.Wait [Now()] + wait_sec / 86400
 
'速度調整:3番 2番と同様に、途中経過が表示されず、何十秒後かに最後の行のグラフだけが表示される
' Application.Wait [Now() + "00:00:00.1"]
         
 
Next i
 
End Sub

回答
投稿日時: 21/11/01 20:26:00
投稿者: simple

要するに描画する余裕がないようなので、例えば下記のようにしてみてはどうでしょうか。
DoEventsの数とか、待ち時間は適当に修正してください。
 

    For i = 1 To p
        With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
            .ChartType = xlLine
            .XValues = Range(Cells(1, 2), Cells(1, q))    '横軸の値を設定
            .Values = Range(Cells(1 + i, 2), Cells(1 + i, q))    'データを設定
            .Name = Cells(1 + i, 1)
        End With
        DoEvents
        DoEvents
        DoEvents
        Sleep 300
    Next i

回答
投稿日時: 21/11/01 22:55:30
投稿者: simple

二つ目の話は、ワークシート上に差分の数値を作って、同様にそれを描画するしかないですね。
ワークシート上にないもの(例えば、なんらかの配列変数)を直接、描画できないと思いますよ。
レンダリングする余裕を持たせるのは、最初の話と同じです。

投稿日時: 21/11/02 11:21:01
投稿者: match13

> simple様
  DoEvents を4回繰り返したら、イメージ通りの描画をできました。
 
ハマっていたのですが、こんなにシンプルな方法で解決するとは驚きです!
差分についても、アドバイ頂き、大変勉強になります。
ありがとうございました!