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

質問

いつもお世話になっております。
約半年前の質問の再質問です。

17行目以降にデータの入った表の2行目に数値（ａ）を入れるとその列の最下行からa個のデータ数でグラフ化される。
同時に同じ列の11行目、12行目の値で2本の横棒をグラフに描きたい。

上記の質問に対し、半年前にここで下記のVBAをさんざん教わったのですが、どうしてもうまく行かず一旦Pendingとしたのですが、あと少しの気がしてもったいなく、今回改めて前回の質問で示されたご回答（下図）と全く同じ３枚のシートを作ってみて試してみたのですが当方の不具合を再現したので改めて質問させていただきます。

下記VBAの不具合内容
グラフ確認シート（補助シート）には「行見出し」と指定した列の指定数のデータが正しくコピーされますが、C列、D列（プラス3σとマイナス３σ）は空白のままになってしまいます。（当方の実シートの再現）

エディタで「F８」を押すと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

回答No.6

HohoPapa · ベストアンサー

Sub test3()

　Const SRowNum = 17 'データ開始行番号
　Const KoumokuRow = 5 '項目名格納行番号

以下省略

End Sub

↑のコードをsheet1モジュールに配置しているのであれば
Module1に配置してください。

sheetモジュール（厳密にはMicrosoftExcelObject）に配置することは
想定していません。

お礼

うまくいきました！！！！

当方のHohoPapaさんの予測以上の無知が原因でした。

本業が忙しい中、本当に申し訳なく、ありがたく。
明日から多くのBookにコツコツ展開していきます。

感謝！　感謝！！　感謝！！！

回答No.5

HohoPapa

当方では再現できないので、ぶっちゃけ、わかりません。
そこで
https://drive.google.com/file/d/1rULLnMydcjeG8L6Ef4T6c7dOf9Scb6y2/view?usp=sharing
に、
当方で指摘のエラーの発生しないブックをポストしましたので
確認してみてください。

回答No.4

HohoPapa

>何度かやって見ましたが黄色の行はでません。

私に誤解があるかもしれません。
当スレッド冒頭で提示されたシートたちのブックは
新規ブックを新たに開き、提示されたコードを配置して実行していると
思っていました。

そうではなく、
課題ブックには提示されたコードのほかにも
マクロが書き込まれているものと思います。

その１つが、
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
で始まるコードですね？
これは、ブックを閉じるときに動作するマクロですので
今回の挙動には関係ないと思います。

そこで、課題ブックに書き込まれたコード全数を
配置先（標準モジュール、シートモジュール、workbookモジュール）を明示して
ポストしてください。
その中のコードと課題コードの兼ね合いの可能性を疑っています。

補足

お手数をおかけしております。

今回の再質問に際し当方も他のVBAとのバッティングを疑い、
新規ブックを新たに開き、提示されたコードを配置して実行しています。
（ですから保護VBAの話は矛盾していました）

今自宅でも再度新規ブックに質問のコードをコピペし試行して見ました。
念のために各シート、This Book、標準モジュールすべてが空白であることも確認しました。

やっぱり同じようにC列、D列には数値がコピーされずに
「実行時エラー　1004　アプリケーション定義またはオブジェクト定義エラー」　と出ます。

いま気付いたのですが、このエラーが表示されているときにカーソルをエクセルシート上に動かすと◎がクルクル回っているような形になっています。（ハングアップした時のマークです）
この状態で　エラーMsgで「OK」をクリックすると黄色の行が出ずに元の状態に戻ります。
（A列、B列には正しく値がコピーされています）

F8で1行づつ実行すると
＞ 'プラス3σ複写'
＞ Range(KSh.Cells(2, 3), KSh.Cells(ERow - SRow + 2, 3)).Value = _
＞ DSh.Cells(LineDataRow1, ColNum1).Value

から次の行に移動したときに上記のエラーMsgが出ます。

回答No.3

HohoPapa

繰り返します。

さらに、エラーメッセージでデバックボタンを押せば
どこかの行が黄色くなるはずです。
その行がどれなのかを教えてください。

また、当方本業に追われていることから
このスレッドに参戦できるのは、平日はこの時間だけです。
コメントを気長に待つか、
他の識者のスピーディーなコメントに期待してください。

補足

お手数をお掛けします。

何度かやって見ましたが黄色の行はでません。

回答No.2

HohoPapa

まず、落ち着いてください。
感想や推測、予想などの返答は無用です。
単に、事実だけを書いてください。

続いて、私の追及しているポイントは、
このスレッドの最初に提示されたコードとシートで起きるエラー
これを特定することです。

あれやこれや、本番のコードや過去の機能追加部分を登場させるのはやめ、
このスレッドの最初に提示されたコードとシート
これに対して

'プラス3σ複写'
Range(KSh.Cells(2, 3), KSh.Cells(ERow - SRow + 2, 3)).Value = _
DSh.Cells(LineDataRow1, ColNum1).Value

この記述を
'プラス3σ複写'
Debug.Print "ERow：" & ERow '<==追加
Debug.Print "SRow：" & SRow '<==追加
Debug.Print "複写先行末：" & ERow - SRow + 2 '<==追加
Debug.Print "複写元数値：" & DSh.Cells(LineDataRow1, ColNum1).Value '<==追加
Range(KSh.Cells(2, 3), KSh.Cells(ERow - SRow + 2, 3)).Value = _
DSh.Cells(LineDataRow1, ColNum1).Value
に書き換えて実行し

過日紹介したイミディエイトに表示される内容を
教えてください。

また、エラーメッセージも教えてください。、

さらに、エラーメッセージでデバックボタンを押せば
どこかの行が黄色くなるはずです。
その行がどれなのかを教えてください。

補足

お世話になります。
ご指摘の通り、そちらとの相違点として「シート保護」に思い当たって慌てて確認不十分で報告してしまいました。

ご指示の試行結果は下記の通りです。
新しく添付と同じ構成の入力表（17行目から60行目に数値）を作り、データ指定数10個、11行目の値「11」で実行しました。

「グラフ確認用」シートには下記のようにC列、D列には1行目に項目名のみが表示されるだけで値のコピーはされずに不具合を再現しました。
（Ａ列、Ｂ列は期待通りのデータが表示されました）

エラーMsgは
実行時エラー"1004"
アプリケーション定義またはアプリケーション定義のエラーです

ERow：60
SRow：51
複写先行末：11
複写元数値：11

行見出し データ プラス3σ マイナス3σ
35 44
36 45
37 46
・ ・
・ ・
44 53

回答No.1

HohoPapa

提示された画像が見にくく、まったく同じにすることができず、
そのためなのか、エラーを再現できません。

そこで、
'プラス3σ複写'
Range(KSh.Cells(2, 3), KSh.Cells(ERow - SRow + 2, 3)).Value = _
DSh.Cells(LineDataRow1, ColNum1).Value

この記述を
'プラス3σ複写'
Debug.Print "ERow：" & ERow '<==追加
Debug.Print "SRow：" & SRow '<==追加
Debug.Print "複写先行末：" & ERow - SRow + 2 '<==追加
Debug.Print "複写元数値：" & DSh.Cells(LineDataRow1, ColNum1).Value '<==追加
Range(KSh.Cells(2, 3), KSh.Cells(ERow - SRow + 2, 3)).Value = _
DSh.Cells(LineDataRow1, ColNum1).Value
に書き換えて実行し

過日紹介したイミディエイトに表示される内容を
教えてください。

また、エラーメッセージも教えてください。

お礼

すみませ～～ん！
取り急ぎ経過報告！

恐らく原因はグラフ確認シートに保護がかかってしまうことではないかと思い当たりました。

かなり前にここで（恐らくHohoPapaさんに）入力されたセルだけに保存時に保護がかかる下記のコードを教わりこの種の全てのBookに採用しています。

このマクロが原因ではないかと思い当たり、This Bookからコードを削除したのですが、何故かマクロ実行後は保護がかかってしまいます。

これを外して試してみようとしたのですが何故かThis Bookのコードを削除してもうまく行かず。
そうこうしているうちにエディターウィンドウの表示がおかしくなってしまってこれを元に戻せなく・・・

取り敢えず上記思い付きを「連絡せねば」とお礼枠に描きました。

これで連絡枠が無くなりましたので、この後何か分かっても報告不可ですのでご了承ください。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Sheets("成績表(提出)").Select
Range("A1").Select
Selection.ClearContents

Sheets("入力表").Select
Range("D2:K2").Select
Selection.ClearContents

Const MyPassword = "" 'パスワード（省略可）
Dim sh As Worksheet
On Error Resume Next
For Each sh In Worksheets
sh.Unprotect Password:=MyPassword
With sh.Cells
'全セルのロックを外す
.Locked = False
'定数が含まれているセルにロックを掛ける
.SpecialCells(xlCellTypeConstants).Locked = True
'数式が含まれているセルにロックを掛ける
.SpecialCells(xlCellTypeFormulas).Locked = True
End With
sh.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True, Password:=MyPassword
Next
On Error GoTo 0

補足

毎度、毎度、・・・・・です。
早速試してみたのですが、どうもご指示の内容通りに出来ていないように思われます。
ご回答の通りに”プラス3σ”の処のコードのみを変更して（Test 12/8)実行するも、イミディエイトWinには何も表示されず。
そこで過去のTest No3に戻して実行するも何も表示されず。
色々やっているうちに気付くとWinに何やら表示が。
それで更に同じことを繰り返してみて、表示が出るのはプロシージャーの実行時ではなく、2行目の数値を入力、削除した時だとわかりました。

そこで一旦全部元の状態に戻して過去のTest No3と今回のTest 12/8で2行目を操作した時にWinに表示されたコメントが下記です。

エラーMsgは、
Test No3は「アプリケーション定義またはオブジェクトの定義エラー」
Test 12/8は「実行時エラー”９”」
「インデックスが有効な範囲にありません」
でした。

HohoPapaさんの方ではやっぱり正常に動くということなので1つ気になったのは、「グラフ」シートに最初に準備するグラフは、入力表の適当な1列のデータで作成したグラフを「グラフ」シートに貼り付けているのですが、この事前に準備しておくグラフの作成方法が違っていないでしょうか？
一応3系列のグラフや事前に「グラフ」シートに元グラフを作成しないケースも試してみたのですがどれも駄目でしたが気になりました。

当方が勝手に推測するのは、
「グラフ確認」シートに11行目と12行目の数値がコピーされればグラフ化される気がするので、あと少し？何か基本的なことが修正出来ればと思っての再質問です。
しつこくて本当にすみません。

ただ、この課題は常に思っていることであり、またもう少しの感じがしてならないので何とかお願いします。
ここまで手間をかけてもらっているので何とか完成したい！！！

Test No3
開始行: 17 / 終了行: 17 / 対象列番号: 3
開始行: 39 / 終了行: 68 / 対象列番号: 10
開始行: 39 / 終了行: 68 / 対象列番号: 8
開始行: 39 / 終了行: 68 / 対象列番号: 6
開始行: 39 / 終了行: 68 / 対象列番号: 4
開始行: 40 / 終了行: 69 / 対象列番号: 10
開始行: 40 / 終了行: 69 / 対象列番号: 8
開始行: 40 / 終了行: 69 / 対象列番号: 6
開始行: 40 / 終了行: 69 / 対象列番号: 7
開始行: 39 / 終了行: 68 / 対象列番号: 6
開始行: 39 / 終了行: 68 / 対象列番号: 10
開始行: 40 / 終了行: 69 / 対象列番号: 7
開始行: 39 / 終了行: 68 / 対象列番号: 9
開始行: 39 / 終了行: 68 / 対象列番号: 8
開始行: 40 / 終了行: 69 / 対象列番号: 10
開始行: 40 / 終了行: 69 / 対象列番号: 9
開始行: 39 / 終了行: 68 / 対象列番号: 7
開始行: 40 / 終了行: 69 / 対象列番号: 4
開始行: 40 / 終了行: 69 / 対象列番号: 9
開始行: 39 / 終了行: 68 / 対象列番号: 9
開始行: 40 / 終了行: 69 / 対象列番号: 6
開始行: 39 / 終了行: 68 / 対象列番号: 7
開始行: 39 / 終了行: 68 / 対象列番号: 4
開始行: 40 / 終了行: 69 / 対象列番号: 8
開始行: 40 / 終了行: 69 / 対象列番号: 4
開始行: 17 / 終了行: 17 / 対象列番号: 3
開始行: 40 / 終了行: 69 / 対象列番号: 5
開始行: 39 / 終了行: 68 / 対象列番号: 5
開始行: 39 / 終了行: 68 / 対象列番号: 5
開始行: 40 / 終了行: 69 / 対象列番号: 5

Test 12/9
開始行: 17 / 終了行: 17 / 対象列番号: 3
開始行: 39 / 終了行: 68 / 対象列番号: 10
開始行: 39 / 終了行: 68 / 対象列番号: 8
開始行: 39 / 終了行: 68 / 対象列番号: 6
開始行: 39 / 終了行: 68 / 対象列番号: 4
開始行: 40 / 終了行: 69 / 対象列番号: 10
開始行: 40 / 終了行: 69 / 対象列番号: 8
開始行: 40 / 終了行: 69 / 対象列番号: 6
開始行: 40 / 終了行: 69 / 対象列番号: 7
開始行: 39 / 終了行: 68 / 対象列番号: 6
開始行: 39 / 終了行: 68 / 対象列番号: 10
開始行: 40 / 終了行: 69 / 対象列番号: 7
開始行: 39 / 終了行: 68 / 対象列番号: 9
開始行: 39 / 終了行: 68 / 対象列番号: 8
開始行: 40 / 終了行: 69 / 対象列番号: 10
開始行: 40 / 終了行: 69 / 対象列番号: 9
開始行: 39 / 終了行: 68 / 対象列番号: 7
開始行: 40 / 終了行: 69 / 対象列番号: 4
開始行: 40 / 終了行: 69 / 対象列番号: 9
開始行: 39 / 終了行: 68 / 対象列番号: 9
開始行: 40 / 終了行: 69 / 対象列番号: 6
開始行: 39 / 終了行: 68 / 対象列番号: 7
開始行: 39 / 終了行: 68 / 対象列番号: 4
開始行: 40 / 終了行: 69 / 対象列番号: 8
開始行: 40 / 終了行: 69 / 対象列番号: 4
開始行: 17 / 終了行: 17 / 対象列番号: 3
開始行: 40 / 終了行: 69 / 対象列番号: 5
開始行: 39 / 終了行: 68 / 対象列番号: 5
開始行: 39 / 終了行: 68 / 対象列番号: 5
開始行: 40 / 終了行: 69 / 対象列番号: 5