グラフに横棒を引きたい（追加質問）

質問

いつもお世話になっております。
12／13に下記のご回答をいただいて複数のBookに展開し始めたのですが、どうしても追加の機能が必要なケースがあることに気付いたので追加のお願いです。
これができないと展開できるBook、対象列が限られてしまい非常に勿体無いので、これだけは何としても解決したく追加の質問させていただきます。
尚、実Bookに展開するにあたり、「グラフ」は半角に、グラフ確認用のシートのA~D列に保護解除のコードを修正、追加しています。

急ぎませんので何とか宜しくお願い致します。

＜必須機能＞
【対象とする列の最下行（1048576行目）から上方向に1行ずつチェックして数値、あるいは計算結果が数値になっている最初のセルにしたい】です。

Sub グラフ確認()

Const SRowNum = 17 'データ開始行番号
Const KoumokuRow = 5 '項目名格納行番号
Const ShNameGD = "入力表" 'データ格納シート名
Const ShNameGr = "グラフ" 'グラフ描写シート名
Const ShNameGK = "グラフ確認用"
Const XCol = 2 '横(項目)軸ラベル列番号
Const LineDataRow1 = 6 'プラス3σ行位置
Const LineDataRow2 = 7 'マイナス3σ行位置
Const KeyRow = 2 '採用データ数格納行番号

Dim GSh As Worksheet
Dim DShj 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

Sheets("グラフ確認用").Select
Columns("A:D").Select
ActiveSheet.Unprotect
Sheets("グラフ").Select

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

回答No.1

HohoPapa · ベストアンサー

過日紹介したコードと同等のコードを追加することとなりましょう。
後記コードです。
なお、動作確認していませんので、
異常、期待以外な動きがあればお知らせください。

Sub グラフ確認()

　'部分省略

　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　　'<==ここ
　'下から上方向に、数値となっているセルを探す
　'//-------------------------ここから
　Do
　　If IsNumeric(dsh.Cells(ERow, colnum1).Value) = True Then Exit Do
　　If ERow <= SRowNum Then Exit Do
　　ERow = ERow - 1
　Loop
　'//-------------------------ここまで

　If ERow < MaxRows + SRowNum Then
　　SRow = SRowNum
　Else
　　SRow = ERow - MaxRows + 1
　End If

　'部分省略

End Sub

お礼

お世話になります。
一発OKでした。

早々のご回答まことにありがたく。
昨夜追加質問するかどうか迷いましたが、これほどお手数をお掛けしたコードたちが使えない列を残すよりは完成形に仕上げたい、との思いの方が強く追加質問させていただきました。

本当にありがとうございました。

補足

実は先日教わったコードを

＞'データ複写'
Range(DSh.Cells(SRow, ColNum1), DSh.Cells(ERow, ColNum1)).Copy _
KSh.Cells(2, 2)

の前後に適当に挿入してみたのですが当然駄目でした。
とほほ・・・・・