エクセルで2つの項目を下から規定数のデータでグラフ

質問

15枚のシートに同じ書式の表がありそのシート上に任意の2列の列データを下から30個指定してグラフ化したいのです。
表に空白セルは無く、データ数が30個以下の場合は全数でグラフ化したい。

製品A、製品B・・・というように製品名のシートが15枚あります。
この表の2列のデータを下から30個でグラフ化したく。列は固定することも可です。

データ数や項目行やデータの開始行は下記の様にコード中で指定でも問題なく使用できると思いますが、もし可能なら添付の図のように決まったセルから指定できれば最高です。

コード中での指定の場合表がずれた場合に不都合になってしまいますが、今のところ表の位置を合わせることもできそうですので必須条件ではありません。

Const MaxRows = 30 'データ範囲に指定する最大行数
Const ColNum1 = 5 '1つ目データ格納列
Const ColNum2 = 7 '2つ目データ格納列
Const SRowNum = 17 'データ開始行番号
Const KoumokuRow = 5 '項目名格納行番号

回答No.3

SI299792 · ベストアンサー

画像には「製品Ａ」～「製品Ｄ」のシートしかありません。
これでは、全てのシートにグラフを作るのだと思ってしまいます。現実に近い画像を上げて下さい。

でしたら、グラフデータの範囲の変更の方がいいですね。グラフが無いとエラーになります。
１番最初に作ったグラフが対象です。グラフが複数ある場合（無いと思いますが）対象となるグラフを右クリック、最背面へ移動、最背面へ移動、を行ってください。
Option Explicit
'
Sub Macro1()
　　Dim RSta As Integer
　　Dim REnd As Integer
'
　　REnd = Cells(Rows.Count, [C7].Value).End(xlUp).Row
　　RSta = WorksheetFunction.Max([C10], REnd - [C9] + 1)
　　Range([C7] & [C8] & "," & [C7] & RSta & ":" & [C7] & REnd & "," & _
　　　　　[D7] & [C8] & "," & [D7] & RSta & ":" & [D7] & REnd).Select
　　ActiveSheet.ChartObjects(1).Chart.SetSourceData Selection
End Sub

グラフにもボタン同様、マクロの登録か可能です。グラフをクリックすると範囲が変わるので面白いです。下は、グラフにとマクロを登録するマクロです。必要なら使って下さい。一度動かせば後は必要ありません。
'
Sub Macro2()
　　Dim Sheet As Worksheet
　　Dim Chart As Object
'
　　For Each Sheet In Worksheets
'
　　　　If Sheet.ChartObjects.Count > 0 Then
　　　　　　Sheet.ChartObjects(1).OnAction = "Macro1"
　　　　End If
　　Next Sheet
End Sub

お礼

本当にお手数をおかけしました。

遅ればせながら補足に要求内容の詳細を記載しました。
今動作確認し期待通りの動作を確認しました。

このマクロは汎用性が高いのでこのBookだけではなく過去の、今後の表にも適用できそうです。

本当にありがとうございました。
あの質問と補足からのご回答の完成度の高さに驚きました。

補足

何度も済みません。
質問（要求事項）が大抜けのためお手数をおかけしてしまいました。

＞画像には「製品Ａ」～「製品Ｄ」のシートしかありません。
確かに動作確認のために4枚のシートを予め成してその画像をアップしてしまいました。

実際には15枚のシートに同じ書式の表があり、それぞれのシートにそれぞれのグラフを作成したいのです。

よってシートの上部のセルにそれぞれ製品のグラフ化したい項目を指定できるようになればありがたく。
もし、全部のシートで同じ列指定になるなら目的の項目列を指定（例えばAとB列）にした表に列を組み替えて作表します。

それぞれの製品シートで、例えば製品A（シート）は幅と重さ、製品Bは縦の長さと横の長さをグラフにしたいのです。

つまり製品AのシートはC列とF列、製品BのシートではA列とD列をグラフにしたいのです。
製品Aのシートに特性を入力後ボタンでグラフで傾向が確認でき、後で製品Fの試験結果を追記した時に製品Fの2つの特性をグラフで確認する。といった目的です。

本当に説明不足で申し訳ありません。

回答No.2

SI299792

折れ線グラフですね。
グラフタイトルはいれなくていいのですか。
対象列 C7,D7
項目名 C8 に入っている行
行数 C9 （30固定ではない）
開始行：C10 股は、下から C9 上
としました。
Option Explicit
'
Sub Macro1()
　　Dim Sheet As Worksheet
　　Dim RSta As Integer
　　Dim REnd As Integer
'
　　For Each Sheet In Worksheets
　　　　Sheet.Select
　　　　RSta = [C10]
　　　　REnd = Cells(Rows.Count, [C7].Value).End(xlUp).Row
　　　　RSta = WorksheetFunction.Max([C10], REnd - [C9] + 1)
　　　　Range([C7] & [C8] & "," & [C7] & RSta & ":" & [C7] & REnd & "," & _
　　　　　　　[D7] & [C8] & "," & [D7] & RSta & ":" & [D7] & REnd).Select
'
　　　　With ActiveSheet.Shapes.AddChart2(332, xlLineMarkers)
　　　　　　.Left = [I15].Left
　　　　　　.Top = [I15].Top
　　　　End With
　　Next Sheet
End Sub

補足

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

昨夜ダミーシートで色々試行してみました。
驚くほど簡単にグラフが作成されてビックリしましたが、実シートを想定した場合ぜひ改良をお願いたい点がいくつかあることがわかりました。

追加要求になりますが何とかなる範囲でぜひ改良をお願いしたいのですが。。。。
マクロでは非常に大変な部分は表で合わせ込むか、手作業で対応するつもりですので出来る範囲でよろしくお願いします。

１．マクロを実行するたびに全シートに新規にグラフが作成されますが、前のグラフを削除後に新規に作成されるか、できれば既存のグラフ（シートに事前準備）の同じ設定のグラフのデータのみ更新されるとありがたい。
第２軸の設定等見やすく加工したグラフの値のみの更新がありがたい。
２．Sheet1に表紙＝各品名のシートにジャンプするための表のない書式違いのシートがあるので実行するとアクティブシートから始まってSheet１でエラーになってしまいます。
３．マクロを実行すると最後の表シートにジャンプして止まるのでデータを入力したシートを探して戻る必要があります。（＝最後に違う製品のグラフが表示されてしまいます）

４．できればマクロボタンをクリックしたアクティブシートのみで動くようにできないでしょうか？

毎回全部のシートの表が更新は不要で入力の都度グラフで傾向を確認したいのです。

お手数をおかけすることも申し訳ありませんがよろしくお願いします。

回答No.1

HohoPapa

後記コードのようになるんじゃないかと思います
なお、動作確認も文法チェックを行っていませんので
事前に確認してください。

また、
Z列までしか考慮していませんし、
対象列の指定（C7,D7セル）は、必ず半角大文字で指定する必要があります。

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

　ActiveSheet.Unprotect

　Const ShNameGD = "入力表" 'データ格納シート名

　Dim MaxRows As Long 'データ範囲に指定する最大行数
　Dim ColNum1 As Long '1つ目データ格納列
　Dim ColNum2 As Long '2つ目データ格納列
　Dim SRowNum As Long 'データ開始行番号
　Dim KoumokuRow As Long '項目名格納行番号

　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.ActiveSheet
　Set DSh = ThisWorkbook.Sheets(ShNameGD)

　MaxRows = GSh.Cells(9, 3).Value 'データ範囲に指定する最大行数
　ColNum1 = Asc(GSh.Cells(7, 3).Value) - 64　'1つ目データ格納列 Aなら1、Bなら2...
　ColNum2 = Asc(GSh.Cells(7, 4).Value) - 64 '2つ目データ格納列
　SRowNum = GSh.Cells(10, 3).Value 'データ開始行番号
　KoumokuRow = GSh.Cells(8, 3).Value '項目名格納行番号
　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

補足

こんばんは。
早々のご回答ありがとうございます。

早々に試してみました。
今更ですが、このご回答のコードはどこに入れるのでしょうか？
１．標準モジュール
２．シートモジュール
に入れて実行してみたのですが
＞Set DSh = ThisWorkbook.Sheets(ShNameGD)　
が黄色にハイライトで止まります。

動かないことは慣れているのですが下記に違和感があります。
＞ Const ShNameGD = "入力表" 'データ格納シート名
とありますがデータ格納シート名は、製品Aとか製品B、製品Cというそれぞれのシート上の同じ場所に表があります。
つまり製品毎にシートがあり、それぞれのシートの表の横にグラフを表示したいのですが。
各製品の試験結果を表に入力後「グラフ」ボタンを押すと最新の傾向がグラフ化されるようにしたいのです。
この時に対象列とデータ数をアクティブシート（各製品のシート）上で指定できれば非常に便利なのです。

例えば、製品AはB列とD列で最新の20ロット分のグラフ、製品BはD列とF列で50ロットのグラフ・・・というようにできれば最高ですが、対象列をコード上で固定するならそれぞれの欲しい列（項目）を指定の列に合わせた表にして入力します。

この場合は生（紙）データからエクセル表に転記するときに入力順を変えることが必要になるのでできれば各シート上で指定出来ればありがたいのです。（滅茶苦茶便利になるので他でも使えると思います）
実は昔、データ格納シート名を「成績表」として、グラフ描写シート名も「成績表」にして試してみましたがダメでした。（当然！）

今回別の要求から今回のお願いになりました。

急ぎませんのでお時間のある時にご教示お願いします。