エクセルでグラフを自動作成マクロの改良

質問

いつもお世話になっております。
過去にここで指定した列の下から指定の個数のデータを自動で作成するマクロを教えていただき本当に便利に多くのファイルで使用しているのですが、これが定着してきたら次の欲が出てきました。

各列の決まったセルに数字を入れて（D列をグラフにしたいときにはD2に50と入れて）マクロボタンを押すと指定のシート（成績表）に飛んでその列のグラフが指定のデータ数（50個）でグラフになればありがたいのですが。。。。

項目名は5行目になっているのですが、この場合はグラフ化する項目は必要時に指定するので項目名の表示は無くてもOKです。（あれば更にOK）

'//------------------------'データ列１列
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 '横(項目)軸ラベル列番号（下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.4

HohoPapa · ベストアンサー

>だとすれば、変数は２つありますので、
>これらの変数を指定するセルは、２つ用意したほうがわかりやすく
>扱い易いハズです。

そうではなく、
>>D列をグラフにしたいときにはD2に50と入れて
データ格納シートの2行目は、対象としたい列以外は空欄
つまり、
2行目で値の埋まっているセルはD列（D2セルだけ）ですか？

F列をグラフにしたいときにはF2に40と入れ
2行目の他のセルは全数空欄
という仕様にしたいですか？

であれば

　MaxRows = DSh.Cells(2, 4).Value 'D2セル
　ColNum1 = DSh.Cells(3, 4).Value 'D3セル

を

　MaxRows = DSh.Cells(2, Columns.Count).End(xlToLeft).Value
　ColNum1 = DSh.Cells(2, Columns.Count).End(xlToLeft).Column

としてください。

お礼

毎度、毎度お世話になりっぱなしです。

さて、朝一で動作確認してみました。
いつものようになんだかや、少してこずりましたが、期待通りに動くこと確認しました。
過去のコードで動作確認できているので間違いないとは思っていましたが。

やはり完全に空いている行は無いので2行目を挿入して試したのですが、マクロの行数がズレるのでこの修正が必要でした。

一番困ったのは、「成績表」シートにグラフが2つになるので、今回のグラフを追加（同じシートに2枚のグラフ）にしても両立しないことが分かりました。
マクロを変えると既存のグラフと今回のグラフが切り替わりますが、元の(重要項目）のグラフが消えること、元のグラフに設定した軸の設定が無くなってしまうのでこれは許容不可。

これについては最初の質問時に確認され「グラフ描画シートにグラフは1つ」が前提だったのでこれの改良よりは「グラフ」シートを追加することで解決しました。
HohoPapaさんなら最初から要求していれば、グラフ１とグラフ２を区別して実行はできると思いますが、更にお手数をかけること、既存のマクロの変更を伴うので当方にとっても非常に効率が悪いのでこれはシートの追加で対処が正解です。

また、2行目に複数のデータが入っていた場合、エラーにならずに右の列から優先で採用されること、データ数が実際のデータ数よりも大きな値を入れても問題無いことを確認しました。（長期間の推移を見たいときには適当に200とか入れますので）

コードが汎用的で ’注釈があるので本当に助かります。

本コードはこれから順次多数のファイルに展開していく予定ですが、今は気づいていない問題が発生した節にはまたよろしくお願いいたします。

うまくいって気分が良いので、細々と報告が長くなってしまいました。

補足

当方の応答が悪く何度も忖度の回答をいただいてしまい本当に申し訳ありませんでした。

>D列をグラフにしたいときにはD2に50と入れて
＞データ格納シートの2行目は、対象としたい列以外は空欄
＞つまり、
＞2行目で値の埋まっているセルはD列（D2セルだけ）ですか？

これが意図です。
ただし空いている行はいくつかのBookを確認して決めるつもりでした。
無ければ上の方に1行挿入して専用の行を作るつもりでした。

変数の場所も確認して6行に入力した場合でも動くことを確認しました。

月曜日に本チャンのシートで動作確認して報告させていただきます。

本チャンのシートはご指摘のコードも入っているので念のため両立することを確認しておきます。

とはいっても、当該コードもHohopapaさんのコードなので大丈夫だと信じますが、当方がHohopapaさんの想定外のことをやっている可能性もありますので。

応答が遅くなり申し訳ありません。

回答No.5

imogasi

全回答に、反応もないので、「多分こうじゃった、のじゃないか？」と推測して、下記作ってみた。
　外れている点を補足すれば、他の回答者にも参考になるのではないか？
他の回答者も、「だと思います」と言っているようだが、趣旨がよくわからないのでは。
質問をして、回答に、補足もお礼もすぐ、してないようだが、そういうのは、どうだろう。
回答は、例を作ったり、文章を書く時間もあるが、回答者のこの分野の、一生の経験が、反映している点を考えてほしい。
ーー
質問する際には、こういう、模擬データ例を挙げて質問すべきではないか？
データ例　Sheet1
A1:F8
氏名 一月 二月 三月 四月 五月　一、二、五月デーら例は省略。
山田 55 56.6
佐藤 49.8 62
鈴木 58.6 58.9
田中 51.4 66.2
今井 65.8 73.5
近藤 63.4 80.8
伊藤 51.4 88.1
ーー
もし三月を選べばA列とD列データで、四月を選べばA列とE列データでグラフ
を描く。仮にグラフは、折れ線グラフとする。
何月の選択はリストボックスで指定する。シートのセル選択イベントなどを使う方法もあるが、本件では使わない。
ーー
ユーザーフォームが表示されるときに、Listboxのアイテムに、何月の一覧を作る。
Private Sub UserForm_Initialize()
For i = 2 To 6
UserForm1.ListBox1.AddItem Worksheets("Sheet1").Cells(1, i)
Next i
End Sub
リストボックスで、月を選択したら、下記が実行される。
Private Sub ListBox1_Click()
Set awf = Application.WorksheetFunction
Set sh1 = Worksheets("Sheet1")
ttl = UserForm1.ListBox1.Text
MsgBox ttl
c = awf.Match(ttl, sh1.Range("A1:J1"), 0)
MsgBox c
'====-
With sh1.Shapes.AddChart.Chart
.ChartType = xlLine ' xlColumnClustered
.SetSourceData Union(sh1.Range("A1:A8"), sh1.Range(Cells(1, c), Cells(8, c)))
End With
End Sub
A列と選択した月の列のデータで、折れ線グラフが描かれる。
ーー
質問者にすれば、自分の質問に載せたコードを添削してほしいのだろうが、
こういう機会に、他の路線のやり方も勉強しないと進歩しないと思う。

お礼

ご回答ありがとうございました。
動作確認する時間がとれなかったのでお礼が遅れ申し訳ありませんでした。

なかなか進歩しないです。

回答No.3

HohoPapa

No2のついでに。。。
シート名を固定値で持っていますので、
以下のほうがスマートと思います。

'//------------------------'データ列１列
Sub GraphSauceChange9_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　　　　'データ範囲に指定する最大行数
　Dim ColNum1 As Long　　　　'1つ目データ格納列

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

　GSh.Select
　GSh.Unprotect

　MaxRows = DSh.Cells(2, 4).Value 'D2セル
　ColNum1 = DSh.Cells(3, 4).Value 'D3セル

　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

お礼

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

最初に本命のコードを試して完璧に完了ですが、これも動作確認してみました。

表のA1,A2は確実に空いているのでこれを使うことも可能です。
コードに’D2セル、’D３セルとの注釈がありますので当方でも任意のセルに変更は可能ですので。

ただし、使う人には求めたい項目の列に数字を入れる方が分かりやすいので3つ目のを採用すると思います。

毎度お手数をおかけします。

回答No.2

HohoPapa

https://okwave.jp/qa/q9656678.html#a_area
https://okwave.jp/qa/q9649813.html#a_area
これらの延長にある課題と思います。

求めているのは．．．、

Const MaxRows = 50 　　　 'データ範囲に指定する最大行数
Const ColNum1 = 6 　　　 '1つ目データ格納列
といったコードで、
グラフに使うデータ範囲の最大行数と
グラフ用のデータが何列目にあるのかを
固定的に持っているわけですが

これを、
適当なセルの値で指定する（変数にしたい）ということ思います。

だとすれば、変数は２つありますので、
これらの変数を指定するセルは、２つ用意したほうがわかりやすく
扱い易いハズです。

グラフに使うデータ範囲の最大行数をデータ格納シートのD2から、
グラフ用のデータが何列目にあるのかをデータ格納シートのD3から、
それぞれ取得するのであれば、
以下のようなコードになります。
（動作確認を一切していませんので、期待と違うようなら指摘してください）

'//------------------------'データ列１列
Sub GraphSauceChange9_1()
　Sheets("成績表").Select
　ActiveSheet.Unprotect
　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 　　　 'データ範囲に指定する最大行数
　Dim ColNum1 as long 　　　 '1つ目データ格納列

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

　MaxRows = DSh.cells(2,4).value 'D2セル
　ColNum1 = DSh.cells(3,4).value 'D3セル

　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

お礼

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

上の2つとも動いたのでこれは余裕で最初からA1、A2に変えてみて試しましたが期待通りに動きました。
項目数が多いものは20個（列）近くありますので、列を数字で入力するより、目的の列で直近20個とか５０個のグラフがかけた方が使いやすいですので、3つ目のご回答がBESTだと思っています。

回答No.1

imogasi

>D列をグラフにしたいときにはD2に50と入れて）マクロボタンを押すと
コマンドボタンを、データシートに作り、D2を入力し、それをクリックするのか？シートのデータChangeイベントでも使うのかな？
凝った仕様だな。
ーー
D列データをグラフにするときはD2に、使うデータ行数を入れるのか？
F列データをグラフにするときはF2に使う行数を入れるのか？
変わったつくりだな。列全データではないの？
どの行からスタートして５０行か？
ーー
グラフの種類は何か？
項目名に当たるデータはA列にあるのか？名前とかそのデータの発生主体の識別名はあるだろうし、必須だろう。１列データだけで、普通はグラフは描かない。
ーー
＞マクロボタンを押すと指定のシート（成績表）に飛ん・・
D列のデータのグラフは成績表シートとして、それら列対応のシート名を割り出すのはどうするのか。
ーー
質問に乗せた、VBAコードは、この質問に関係するコードなのか？
ーー
もっとVBA的に、必要な要素技術は何かを勉強し、それに限定した質問にすべきだろう。
初心者が、思いつくまま、便利そうな機能（素人でも思いつくのは簡単なものも多い）を盛り込んでプログラムしようするのは勉強上よくないと思う。
・ボタンを押して実行させる
・指定場所を相対化する・都度変える・自動で割り出す
などは学習上の一段上のスキルだろう。
　それらを多用すると、結局丸投げになり、回答をまる写しになり、出来ましたという判定しかせず、実力がつかないと思う。

お礼

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

返事こくれてすみませんでした。
お指摘参考になりました。