エクセルで最新の50個のデータを含むグラフを作成したい

質問

• エクセルで最新の50個のデータを含むグラフを作成する方法について教えてください。
• シートには日付と2つの特性が列ごとに記録されていますが、データの数が大きく異なるため、自動作成されたグラフの表示が目的と異なっています。
• 特性ごとに最新の30個または50個のデータを含むグラフを自動作成する方法を教えてください。

回答No.8

HohoPapa · ベストアンサー

>本チャンのブック
のデータレイアウトが未詳のままではありますが、
>データ範囲が41行目から79行目に固定されてしまうようです。
の問題は、以下にポストするコードで解決するはずです。
なお、1列目は、
データ開始行（17行目）以下、
有効行末まで空行なく埋まっている前提です。

>横軸の指定がグラフ要素になってしまう
これは多少予想していました。
横（項目）軸ラベルの範囲設定と
データ要素群の範囲設定の区別方法についての
私の理解が浅く手探りだからです。

ともあれ、
期待のグラフを右クリックし、
データの選択を選び、
表示される設定画面、凡例項目に余分な行があれば削除し
横（項目）軸ラベルは、編集を選び
明示的に範囲を指定してみてください。

その後、以下にコードを2種類ポストしますので
それぞれ試してみてください。
ポストしたコードはそれぞれデータ要素が２つある前提で
前者は、横（項目）軸ラベルを指定するコード
後者は、横（項目）軸ラベルを指定しないコードです。

Sub GraphSauceChange2()

　Const MaxRows = 10　 'データ範囲に指定する最大行数
　Const TgShNum = 2　　'対象シート番号
'　Const ColNum0 = 8　　'x軸要素名列
　Const ColNum1 = 3　　'1つ目データ格納列
　Const ColNum2 = 5　　'2つ目データ格納列
　Const SRowNum = 17　 'データ開始行番号
　Const KoumokuRow = 5 '項目名格納行番号

　Dim SRow As Long　　 'グラフ用データ開始行
　Dim ERow As Long　　 'グラフ用データ終了行
'　Dim tgRange0 As Range　'X軸ラベル
　Dim tgRange1 As Range　'データ群1つ目範囲
　Dim tgRange2 As Range　'データ群2つ目範囲
　Dim tgRangeA As Range　'上記合計範囲

　With ThisWorkbook.Sheets(TgShNum)

　　ERow = .Cells(.Rows.Count, 1).End(xlUp).Row
　　If ERow < MaxRows + SRowNum Then
　　　SRow = SRowNum
　　Else
　　　SRow = ERow - MaxRows + 1
　　End If

　　MsgBox (SRow & "-" & ERow)　　'デバック用コード

　'　Set tgRange0 = _
　　　Range(.Cells(SRow, ColNum0), .Cells(ERow, ColNum0))
　　Set tgRange1 = _
　　　Range(.Cells(SRow, ColNum1), .Cells(ERow, ColNum1))
　　Set tgRange2 = _
　　　Range(.Cells(SRow, ColNum2), .Cells(ERow, ColNum2))
　 ' Set tgRangeA = Union(tgRange0, tgRange1, tgRange2)　　　'結合
　　Set tgRangeA = Union(tgRange1, tgRange2)　　　 '結合
　　.ChartObjects(1).Chart.SetSourceData Source:=tgRangeA　 'セット

　　.ChartObjects(1).Chart.SeriesCollection(1).Name = _
　　　.Cells(KoumokuRow, ColNum1).Value
　　.ChartObjects(1).Chart.SeriesCollection(2).Name = _
　　　.Cells(KoumokuRow, ColNum2).Value

　End With

End Sub

Option Explicit

Sub GraphSauceChange2()

　Const MaxRows = 10　 'データ範囲に指定する最大行数
　Const TgShNum = 2　　'対象シート番号
　Const ColNum0 = 8　　'x軸要素名列
　Const ColNum1 = 3　　'1つ目データ格納列
　Const ColNum2 = 5　　'2つ目データ格納列
　Const SRowNum = 17　 'データ開始行番号
　Const KoumokuRow = 5 '項目名格納行番号

　Dim SRow As Long　　 'グラフ用データ開始行
　Dim ERow As Long　　 'グラフ用データ終了行
　Dim tgRange0 As Range　'X軸ラベル
　Dim tgRange1 As Range　'データ群1つ目範囲
　Dim tgRange2 As Range　'データ群2つ目範囲
　Dim tgRangeA As Range　'上記合計範囲

　With ThisWorkbook.Sheets(TgShNum)

　　ERow = .Cells(.Rows.Count, 1).End(xlUp).Row
　　If ERow < MaxRows + SRowNum Then
　　　SRow = SRowNum
　　Else
　　　SRow = ERow - MaxRows + 1
　　End If

　　MsgBox (SRow & "-" & ERow)　　'デバック用コード

　　Set tgRange0 = _
　　　Range(.Cells(SRow, ColNum0), .Cells(ERow, ColNum0))
　　Set tgRange1 = _
　　　Range(.Cells(SRow, ColNum1), .Cells(ERow, ColNum1))
　　Set tgRange2 = _
　　　Range(.Cells(SRow, ColNum2), .Cells(ERow, ColNum2))
　　Set tgRangeA = Union(tgRange0, tgRange1, tgRange2)　　　'結合
　　'Set tgRangeA = Union(tgRange1, tgRange2)　　　 '結合
　　.ChartObjects(1).Chart.SetSourceData Source:=tgRangeA　 'セット

　　.ChartObjects(1).Chart.SeriesCollection(1).Name = _
　　　.Cells(KoumokuRow, ColNum1).Value
　　.ChartObjects(1).Chart.SeriesCollection(2).Name = _
　　　.Cells(KoumokuRow, ColNum2).Value

　End With

End Sub

お礼

ものすごい大作を提示していただいて恐縮なのですが、当方には使えそうにない（全く動かず）ので再度具体的な表の構成を添付して別の質問にしましたのでいったん締め切らせていただきます。

お手数をおかけしました。

補足

毎度お世話になっております。

いつもと違って心苦しい報告です。
ご回答の＃１、＃２、＃３、を昨夕より試してみたのですが、#2、#3は全く動く気配なし。
エラーメッセージで目標の行数は正しく表示されます。（81-100等）
行数が足りないときは17-3と出るようです。
その後「エラー400」と出ます。
これ以上は当方にはお手上げ状態。

不思議なのは＃１で、再度試しましたが既報の通りやっぱりダミーシートでは行数が足りていれば期待通りに動くのですが、本チャンのシートだとなぜか動く気配なし。何度も同じコードをコピペして、上部の行数も合わせて確認したのですが違いが判らず。
とほほ・・・・

また、＃１はX軸に数字以外の列を指定すればちゃんとX軸に反映されますが、指定列が数字のみの場合はグラフ系列に取り込まれてしまって要素が3本のグラフができます。
X軸はデータ数になります。ただし、データ数が指定個数以下だと列の数字がX軸に反映されます。（当方には全く不可解ですが情報として）

これまでの経験からHohoPapaさんのご回答でこれほど思うようにいかないのは当方の表の問題だと思います。

そこでいったんこの質問を閉めて本チャンのダミーシートを添付して再度質問させていただくことにさせてください。
もしこれ以上のおんぶは負担が大きいようなら当然ですが無視して、次の機会?に体力温存でお願いします。

本当にいつも質問の不備と知識のなさでお手間をおかけし、重ね重ね申し訳ありません。