エクセルのグラフで横軸を最新の30個で自動更新

質問

HohoPapaさん
いつもお世話になっております。

さて前日下記のコードを教わって随時他のBookにも展開中です。
非常に使いやすく汎用で助かっているのですが、当初からある程度想定された問題が発生しました。

当然あり得るケースとしてグラフ要素が1つしかない場合です。
本日上記のケース（1列以外は5以下、10以上、合格、・・・)が出てきました。
おそらく同じ列を入れればグラフの見た目は1本にできると思っていたのですが、何ともならず。
今更ですが、お恥ずかしい限りで申し訳ありませんがグラフ要素1つの場合の対応をお願いできませんでしょうか?
文字列を指定するとX軸に表示されるようです。（値０のグラフではなくX軸に文字が表示されます）

両方兼用だと複雑になるようなら、別のコード（このコードから数行省略?）でもOKですので何卒よろしくお願いいたします。（レアケースなので使い分けは全く問題なし）
8回目の改良になってしまい本当にすみません。
HohoPapaさんの想定外の低レベル（すでにお気づきかと思いますが・・）ですみません。

Sub GraphSauceChange7()

Sheets("成績表").Select
ActiveSheet.Unprotect

Const MaxRows = 50 'データ範囲に指定する最大行数
Const ColNum1 = 4 '1つ目データ格納列
Const ColNum2 = 6 '2つ目データ格納列
Const SRowNum = 17 'データ開始行番号
Const KoumokuRow = 5 '項目名格納行番号
Const ShNameGD = "入力表" 'データ格納シート名
Const ShNameGr = "成績表" 'グラフ描写シート名

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

Set GSh = ThisWorkbook.Sheets(ShNameGr)
Set DSh = ThisWorkbook.Sheets(ShNameGD)

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

Set tgRange1 = _
Range(DSh.Cells(SRow, ColNum1), DSh.Cells(ERow, ColNum1))
Set tgRange2 = _
Range(DSh.Cells(SRow, ColNum2), DSh.Cells(ERow, ColNum2))
Set tgRangeA = Union(tgRange1, tgRange2) '結合

GSh.ChartObjects(1).Chart.SetSourceData Source:=tgRangeA 'セット

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

End Sub

回答No.1

HohoPapa · ベストアンサー

データ列が２つの場合のコードを加工して
データ列が１つの場合を書いてみましたので
試してみてください。

今回は、これに加え、前回課題として残っていたハズの
'横(項目)軸ラベル　を動的にセットする制御を加えてみました。
期待に合わない場合は
以下の行をコメントアウトしてください。

　Const XCol = 3 '横(項目)軸ラベル列番号
と
　GSh.ChartObjects(1).Chart.FullSeriesCollection(1).XValues = _
　　Range(DSh.Cells(SRow, XCol), DSh.Cells(ERow, XCol))

Option Explicit

'//------------------------'データ列２列
Sub GraphSauceChange8_2()

　Sheets("成績表").Select
　ActiveSheet.Unprotect

　Const MaxRows = 50 'データ範囲に指定する最大行数
　Const ColNum1 = 4 '1つ目データ格納列
　Const ColNum2 = 6 '2つ目データ格納列
　Const SRowNum = 17 'データ開始行番号
　Const KoumokuRow = 5 '項目名格納行番号
　Const ShNameGD = "入力表" 'データ格納シート名
　Const ShNameGr = "成績表" 'グラフ描写シート名
　Const XCol = 3 '横(項目)軸ラベル列番号

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

　Set GSh = ThisWorkbook.Sheets(ShNameGr)
　Set DSh = ThisWorkbook.Sheets(ShNameGD)

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

　Set tgRange1 = _
　　Range(DSh.Cells(SRow, ColNum1), DSh.Cells(ERow, ColNum1))
　Set tgRange2 = _
　　Range(DSh.Cells(SRow, ColNum2), DSh.Cells(ERow, ColNum2))
　Set tgRangeA = Union(tgRange1, tgRange2) '結合

　GSh.ChartObjects(1).Chart.SetSourceData Source:=tgRangeA 'セット

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

　GSh.ChartObjects(1).Chart.FullSeriesCollection(1).XValues = _
　　Range(DSh.Cells(SRow, XCol), DSh.Cells(ERow, XCol))

End Sub

'//------------------------'データ列１列
Sub GraphSauceChange8_1()

　Sheets("成績表").Select
　ActiveSheet.Unprotect

　Const MaxRows = 50 'データ範囲に指定する最大行数
　Const ColNum1 = 6 '1つ目データ格納列
　Const SRowNum = 17 'データ開始行番号
　Const KoumokuRow = 5 '項目名格納行番号
　Const ShNameGD = "入力表" 'データ格納シート名
　Const ShNameGr = "成績表" 'グラフ描写シート名
　Const XCol = 3 '横(項目)軸ラベル列番号

　Dim GSh As Worksheet
　Dim DSh As Worksheet
　Dim SRow As Long 'グラフ用データ開始行
　Dim ERow As Long 'グラフ用データ終了行
　Dim tgRange1 As Range 'データ群1つ目範囲

　Set GSh = ThisWorkbook.Sheets(ShNameGr)
　Set DSh = ThisWorkbook.Sheets(ShNameGD)

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

　Set tgRange1 = _
　　Range(DSh.Cells(SRow, ColNum1), DSh.Cells(ERow, ColNum1))

　GSh.ChartObjects(1).Chart.SetSourceData Source:=tgRange1 'セット

　GSh.ChartObjects(1).Chart.SeriesCollection(1).Name = _
　DSh.Cells(KoumokuRow, ColNum1).Value

　GSh.ChartObjects(1).Chart.FullSeriesCollection(1).XValues = _
　　Range(DSh.Cells(SRow, XCol), DSh.Cells(ERow, XCol))

End Sub

お礼

うまくいきました!!
データ1つの品種のエクセルに8_1をコピペして、3列目のLOT（数字）を指定したところ動かず。
（データ数が少ないので3列目とデータ列だけダミーデータで下に伸ばした表で試してみました）

で、以前うまくいった1列目の日付を下に伸ばして、1列目をX軸に指定したら正常に日付をX軸にしてうまくいきました。が日付ではグラフがおかしくなるので、（表をもとの状態に戻して）想定内のX軸のコードを削除してみましたがうまくいかず。

種々試行して、1列目（日付）が入っている場合、任意の列を指定すると指定列が文字でも数字でも期待するグラフが書けることがわかりました。
1列目は必ず入るのでこれが完成版です。

2系列のほうは今後試してみますが、おそらく同様に1列目にデータが入っていると任意の列がX軸として設定できるでしょう。（私には自信があります???）

万が一でも、すでにVre.７で期待通りに動きますので全く支障なし。
今回もおかげ様で無事目的達成、です。
お礼かたがた今回のグラフの自動化を施したファイル数を数えてみたら今回の1系列の品種でちょうど110品種（ファイル）に展開していました。

いつもながら本当に大感謝!!!
次回のためにご自愛くださいますようお願いします???

補足

いつもいつもありがとうございます。
今回の質問は少し軽率であったと反省し自己解決したことにして質問を閉じようとしたらご回答があり感謝です。

系列が1つのケースはレアケースなのでお手を煩わせてまで自動化する必要はないと気づきました。
データが1つの品種はグラフのところに「グラフは自動更新されないので報告のこと」と目立つように表示しておくことで良しとしようと思っていました。
最初に50個のセルを着色しておいて、色なしセルになったら手動で範囲を再設定する、でも実用上問題なしで対応可能。

ご回答のコードはすぐに試してみたいのですが、現在災害対応中で時間がありません。
結果は必ず報告します。
で、やっぱりうまくいかないと気になる～～～ですが。