グラフに横棒を引きたい(再質問)
いつもお世話になっております。
約半年前の質問の再質問です。
17行目以降にデータの入った表の2行目に数値(a)を入れるとその列の最下行からa個のデータ数でグラフ化される。
同時に同じ列の11行目、12行目の値で2本の横棒をグラフに描きたい。
上記の質問に対し、半年前にここで下記のVBAをさんざん教わったのですが、どうしてもうまく行かず一旦Pendingとしたのですが、あと少しの気がしてもったいなく、今回改めて前回の質問で示されたご回答(下図)と全く同じ3枚のシートを作ってみて試してみたのですが当方の不具合を再現したので改めて質問させていただきます。
下記VBAの不具合内容
グラフ確認シート(補助シート)には「行見出し」と指定した列の指定数のデータが正しくコピーされますが、C列、D列(プラス3σとマイナス3σ)は空白のままになってしまいます。(当方の実シートの再現)
エディタで「F8」を押すと1つずつコードが実行されると知り実行してみるとやはり下記のプラス3σ(11行目)のコピーでエラーになります。
>'プラス3σ複写'
>Range(KSh.Cells(2, 3), KSh.Cells(ERow - SRow + 2, 3)).Value = _
> DSh.Cells(LineDataRow1, ColNum1).Value
下記の図で期待通りに動くとのコメントでしたがやはり何か抜けているように思われます。
Sub test3()
Const SRowNum = 17 'データ開始行番号
Const KoumokuRow = 5 '項目名格納行番号
Const ShNameGD = "入力表" 'データ格納シート名
Const ShNameGr = "グラフ" 'グラフ描写シート名
Const ShNameGK = "グラフ確認用"
Const XCol = 3 '横(項目)軸ラベル列番号
Const LineDataRow1 = 11 'プラス3σ行位置
Const LineDataRow2 = 12 'マイナス3σ行位置
Const KeyRow = 2 '採用データ数格納行番号
Dim GSh As Worksheet
Dim DSh As Worksheet
Dim KSh As Worksheet
Dim SRow As Long 'グラフ用データ開始行
Dim ERow As Long 'グラフ用データ終了行
Dim tgRange1 As Range 'データ群範囲
Dim MaxRows As Long 'データ範囲に指定する最大行数
Dim ColNum1 As Long '1つ目データ格納列
Set GSh = ThisWorkbook.Sheets(ShNameGr)
Set DSh = ThisWorkbook.Sheets(ShNameGD)
Set KSh = ThisWorkbook.Sheets(ShNameGK)
GSh.Select
GSh.Unprotect
MaxRows = DSh.Cells(KeyRow, Columns.Count).End(xlToLeft).Value
ColNum1 = DSh.Cells(KeyRow, Columns.Count).End(xlToLeft).Column
ERow = DSh.Cells(DSh.Rows.Count, ColNum1).End(xlUp).Row '<==ここ
If ERow < MaxRows + SRowNum Then
SRow = SRowNum
Else
SRow = ERow - MaxRows + 1
End If
KSh.Cells.ClearContents
KSh.Cells(1, 1).Value = "行見出し"
KSh.Cells(1, 2).Value = "データ"
KSh.Cells(1, 3).Value = "プラス3σ"
KSh.Cells(1, 4).Value = "マイナス3σ"
'横見出し複写
Range(DSh.Cells(SRow, XCol), DSh.Cells(ERow, XCol)).Copy _
KSh.Cells(2, 1)
'データ複写'
Range(DSh.Cells(SRow, ColNum1), DSh.Cells(ERow, ColNum1)).Copy _
KSh.Cells(2, 2)
'プラス3σ複写'
Range(KSh.Cells(2, 3), KSh.Cells(ERow - SRow + 2, 3)).Value = _
DSh.Cells(LineDataRow1, ColNum1).Value
'マイナスσ複写'
Range(KSh.Cells(2, 4), KSh.Cells(ERow - SRow + 2, 4)).Value = _
DSh.Cells(LineDataRow2, ColNum1).Value
Set tgRange1 = _
Range(KSh.Cells(2, 1), KSh.Cells(ERow - SRow + 2, 4))
With GSh.ChartObjects(1).Chart '<==ここから末まで修正
.SetSourceData Source:=tgRange1 'セット
.HasTitle = True
.ChartTitle.Text = DSh.Cells(KoumokuRow, ColNum1).Value
End With
End Sub
お礼
すばらしい!文句なしです。ありがとうございました。 過去の質問を読んでもイマイチわからなかったので本当に助かりました。