エクセル VBAでセルの値のデータ数でグラフ化

質問

いつもお世話になっております。
この質問は過去にご回答いただいた下記のコードの追加のお願いですのでご了承願います。

下記のコードは指定の列の最下行から指定数のデータ数でグラフを作成するVBAを教えてもらったのですが、今回指定のセル（関数でデータ数をカウント）の値（添付図のB1の値）でグラフを作成したいのです。
グラフは「同じシートの上」の既存グラフの更新（現行のコードのまま）が良いです。
単に下記を同じ名前（両方を入力表）にしてもダメだった記憶有り？

Const ShNameGD = "入力表" 'データ格納シート名
Const ShNameGr = "成績表" 'グラフ描写シート名

現状はデータを下記のコード中で指定した数でグラフ化しているのですが、データ数が15程度から50個以上のケースで使用したく規定数では無くデータ数に応じたグラグにしたく。

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

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

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

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

回答No.3

HohoPapa · ベストアンサー

※1の行を間違えていたようです。
後記高度でいかがでしょうか？

Option Explicit

Sub GraphSauceChange8_2()

　Const ColNum1 = 6 '1つ目データ格納列
　Const SRowNum = 17 'データ開始行番号
　Const KoumokuRow = 5 '項目名格納行番号
　Const ShNameGD = "入力表" 'データ格納シート名
　Const ShNameGr = "入力表" 'グラフ描写シート名
　Const XCol = 3 '横(項目)軸ラベル列番号（下2行と一緒に削除可）

　Dim GSh As Worksheet
　Dim DSh As Worksheet
　Dim SRow As Long 'グラフ用データ開始行
　Dim ERow As Long 'グラフ用データ終了行
　Dim tgRange1 As Range 'データ群1つ目範囲
　Dim MaxRows As Long　'データ範囲に指定する最大行数

　Set GSh = ThisWorkbook.Sheets(ShNameGr)
　Set DSh = ThisWorkbook.Sheets(ShNameGD)
　MaxRows = DSh.Range("B1").Value

　GSh.Select
　ActiveSheet.Unprotect

　ERow = DSh.Cells(DSh.Rows.Count, ColNum1).End(xlUp).Row '※1
　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時間かかりましたが、何とかなりました。
ご回答のグラフ化の前に区切り位置で指定の列にグラフ対象データを持ってこないとグラフ化できないのですが、この自作のVBAと相性が悪く？？？？

後はクローズ時や次の測定のために元の状態に戻すイベントVBAの修正・・・等々

諦めて「降参」しようかと思いましたがあまりに恥ずかしいのと、また抜けが出そうでお手数をかけてしまうと頑張って試行錯誤で何とかなりました！！！！

回答No.2

HohoPapa

求めているものは、
・入力表シート上にグラフを反映する
・データの行数を入力表シートのB1セルの値とする
ということと思います。

入力表シート上に既に、グラフが作成されている前提で、
以下のコードになると思います。

Sub GraphSauceChange8_2()

　Const ColNum1 = 6 '1つ目データ格納列
　Const SRowNum = 17 'データ開始行番号
　Const KoumokuRow = 5 '項目名格納行番号
　Const ShNameGD = "入力表" 'データ格納シート名
　Const ShNameGr = "入力表" 'グラフ描写シート名
　Const XCol = 3 '横(項目)軸ラベル列番号（下2行と一緒に削除可）

　Dim GSh As Worksheet
　Dim DSh As Worksheet
　Dim SRow As Long 'グラフ用データ開始行
　Dim ERow As Long 'グラフ用データ終了行
　Dim tgRange1 As Range 'データ群1つ目範囲
　Dim MaxRows As Long　'データ範囲に指定する最大行数

　Set GSh = ThisWorkbook.Sheets(ShNameGr)
　Set DSh = ThisWorkbook.Sheets(ShNameGD)
　MaxRows = DSh.Range("B1").Value

　GSh.Select
　ActiveSheet.Unprotect

　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

お礼

原因と言うか不具合の詳細が分かりました。
下記のコードで項目名格納行番号は正しく反映されるのですが、データの数がB1セルで決定されるのではなく、
データ開始番号の行数までのデータで作図されます。
下記の場合は項目名を17行目にして、18行目から30行目までのグラフになるようです。

＞Const SRowNum = 30 'データ開始行番号
＞Const KoumokuRow = 17 '項目名格納行番号
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
当方の表の書式が原因かもしれませんが、分析機器からエクセルシートに出力される形式なのでこれに合わせ込むしかない状況です。

出力結果はＤ列の上部に測定条件等が出力されて、17行目に項目、続けて18行目から空白なくデータが10秒置き（設定条件）で測定完了まで出力されます。

正式なソフトでないので、計測時間と測定数値がスペースを挟んで同じセルに入っているので、まずマクロでスペースを区切り位置にしてＤ列に時：分：秒、E列に測定数値が配置されるように細工しています。
D列（X軸）は0:00:00で10秒刻みに出力されます。
区切り位置マクロでDとE列に分けられた表を元にグラフを作図するのが目的です。

測定が3分で終わる場合と15分以上のケースがあるのでB1セルにデータ数をカウントして、そのデータ数で作図したいのです。

お礼枠を使ってしまったので今後何か勘違いに気付いても追加情報は上げられませんのでご了承ください。

何とか宜しくお願いします。

補足

おはようございます。
朝一で取り組んでいますが久々にうまくいかず。

最初に作ってあるグラフ（特性曲線）が消えてしまいます。（よってY軸の値が自動で0-1に更新されます）
エラーが出なくなったのでマクロは正常に動いているようですが、F８で1つずつ動かしてみると最後の4行のコードの、
上の2行でグラフがクリアされ、最後の2行でグラフタイトルと下部に凡例が表れてVBAは正常に終了するようです。

ちなみに表のD列（横軸）の17行目に項目名（TIME）とデータ列のE列の17行目にタイトルが入っており、1-16行目は空白セルを含む文字列（測定条件）が入っています。
指定行より上部のセルは関係ないと思ったのですが、最初にエラーになった際にX軸に上部のセル値が入ったので1-16行目までのセルは空白にして試しています。（当方の設定間違いの可能性あり）

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

回答No.1

imogasi

この質問は丸投げの無料仕事委託ではないですか？
中途まではWEBでしらべて質問すべきでしょう。
今どきでは、Chat-GPTでも質問してみたらどうか。
ーー
Sheet1　コマンドボタンを１つ貼り付ける。
Sheet2　データを作製しておく。
A列、B列、C列　最低で2列、列データを増やしても可。
氏名 国語 数学
山田 77 56
植田 71 72
千田 82 93
下田 59 51
植田 43 79
黒田 49
ここでCTRLキーを押しながら、マウスで、例えば、氏名列と数学列を範囲指定する。
氏名列と国語列と数学列を指定して実行することも可能。
ーー
Sheet1のボタンをclick
Sheet3にグラフが現れる。この例では棒グラフ。
ーー
ＶＢＡ関係
Ｓｈｅｅｔ１のコマンドボタンをclickする。すると
Sheet1のシートモジュール(イベントモジュール）に
Private Sub CommandButton1_Click()
End Sub
が出る。
Private Sub CommandButton1_Click()
test01
End Sub
にする。
test01 (名前は何でもよい）というモジュールを作ることが本件の最大の目的。
ーー
標準モジュールに
'//------------------------'データ列１列
Sub test01()

'Sheets("成績表").Select
'heets(Sheet1).Select

'ActiveSheet.Unprotect

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

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 GSh = Sheets("Sheet2")
' 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))
'ーーーー
MsgBox "AAA"
'既製グラフ抹消
'グラフ化するシートデータ設定
With Worksheets("Sheet2")
.Activate
Set tgRange1 = Selection
MsgBox tgRange1.Address '確認用
End With
Set ChartObj = Sheets("Sheet3").ChartObjects.Add(120, 10, 400, 200) 'ChartObjects とs付き
Set Chart1 = ChartObj.Chart
Chart1.SetSourceData Source:=tgRange1 'データ部分を指定

'GSh.ChartObjects(1).Chart.SeriesCollection(1) = Selection 'KoumokuRow, ColNum1).Value
'
' GSh.ChartObjects(1).Chart.FullSeriesCollection(1).XValues = _
' Range(DSh.Cells(SRow, XCol), DSh.Cells(ERow, XCol)) '（削除可）
End Sub
ワザと質問文のコードを残してコメント化している。勉強のためのつもり。
人によって違う見本。質問例の方が正統的ですが。