[[20150903144924]]　『プログラム全体で実行するとうまくいかない』（こっくさん）　ページの最後に飛ぶ

『プログラム全体で実行するとうまくいかない』（こっくさん）

はじめまして！
当方理系の学生です。
最近になってVBAを知り勉強を始めました。
マクロを組んで実験データを一気に処理させようと思いちょっと長めなマクロを組んで実行してみました。

ところが、実行結果はうまくいっていませんでした。
指定した計算を全てこなしているブックもあれば、一部の計算が抜け落ちているブックもある。といった具合です。

こちらで思い付く計算間違いなどはネットや専門書(VBAの入門書ですが)等を見て全て直しました。
そして1行ずつ実行してみるとちゃんと指定した計算をしてくれていました。
しかし全体を実行するとやはり最初のようにうまく計算をしてくれないブックが出てきます。

これはpcのスペックが足りないからなのか、
エクセルではなく解析用のソフトを使うべきなのか、
あるいは入門書には載っていないようなプログラム内のギミックがあるのか
VBAのまだ勉強を始めたばかりなのでよくわからないのですが、
なにが原因となっているのか詳しい方がいらっしゃったらご教授頂きたいです

プログラムを組むのに苦労した分原因がわからないのがとても悔しいです。
なにとぞよろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

こんにちは

物を見ないとなんとも言えないですけど、一部の計算が抜け落ちているブックの
計算が実行されるタイミングの前の処置辺りに、DoEvents を入れてみるとか、
計算はシート上の数式は使わずにVBA内でセットしていくようにするとか、

やっぱり、物を見ないと・・・
（ウッシ） 2015/09/03(木) 15:18

お約束ｗ

コード、VBAの中身、プログラミング
書いてないとわかりましぇ～～～～～～～～～～～～～～ん。

大学生なんですから
きちんと考えてから書き込みましょうね☆

（02） 2015/09/03(木) 15:19

 皆さんのコメント通り、コードを見ないと何とも言えませんね。
 内容は、難しい数理計算なんだと思いますので、算数音痴のβがコードを見ても理解はできないと思いますが
 少なくとも再現テストはできますので。

 １行ずつ実行というのはステップ実行をしたということでしょうか？
 計算ではありませんが、ステップ実行をすると問題なく処理される。でも普通に実行するとエラーになるというのは
 実はＶＢＡの世界ではめずらしいことではありません。

 ＶＢＡはインタープリータで、かつ、１行ごとに確実に処理しているのではなく、１行を、その処理をつかさどる機能に丸投げ。
 で、その行の実行が終わったかどうかはおかまいなしに、次の行の実行にすすむ。
 多くの場合は、ここで、エラー（オートメーションエラー等々）になりますが、コードの先頭あたりに
 On Error Resume Next なんて記述をする人が（特に、古参の、そこそこの権威の方々）おられます。
 そういう先生の指導を受けた人は、何の疑問も持たずに、やはり記述してしまう。
 実際に、βが現役時代に入社してきた若手が、そういった記述をしていました。

 まぁ、エラートラップに限らず、実際には、処理が間に合っていないのに実行されるというのは、ありうることかと。
 ウッシさんが指摘されるように、困った時の DoEvents。適切な場所に、それをいれこめばＯＫになるケースもあります。

 いずれにしても、コードを拝見したいですね。

（β） 2015/09/03(木) 15:39

F9キーを押すと再計算されて正しい値になる、という場合、オプションの計算方法が自動以外になっている可能性。
（???） 2015/09/03(木) 15:53

（こっくさん） 2015/09/03(木) 16:37

不慣れですみません。
プログラムを書くのを忘れていました！

とくに難しい計算等はないです。
どの部分が悪いのかがわからないので、使ったプログラムをまるまるのせます。
プログラミングに慣れていないので見にくいかも知れませんが、ご容赦願います。
Sub 一括解析()

    Dim Pro As Integer
    Pro = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Dim BlockLineNumber As Integer
    Dim BlockColumnNumber As Integer
    Dim CellNumber As Integer
    Dim count As Integer
    count = 0
    For BlockLineNumber = 1 To 8
        For BlockColumnNumber = 2 To 9
            CellNumber = 1
            On Error Resume Next
            Workbooks.OpenText "D:\Desktop\実験データ\sample1-" & BlockLineNumber & BlockColumnNumber & "-" & CellNumber & ".txt", DataType:=xlDelimited, Space:=True
            If Err.Number <> 0 Then
                Workbooks.Add.Sheets(1).name = "No Data" & CellNumber
            Else
            End If
            On Error GoTo 0
            For CellNumber = 2 To 4
                count = count + 1
                On Error Resume Next
                Workbooks.OpenText "D:\Desktop\実験データ\sample1-" & BlockLineNumber & BlockColumnNumber & "-" & CellNumber & ".txt", DataType:=xlDelimited, Space:=True
                Sheets(1).Move After:=Workbooks(2).Sheets(CellNumber - 1)
                If Err.Number <> 0 Then
                    If (CellNumber > 4) Then
                        GoTo 30
                    Else
                        Worksheets.Add After:=Workbooks(2).Sheets(CellNumber - 1)
                        Workbooks(2).Sheets(CellNumber).name = "No Data" & CellNumber
                        GoTo 20
                    End If
                Else
                End If
                On Error GoTo 0
20          Next
30 For CellNumber = 1 To 4 
                Dim SheetsName As String
                Dim NoDataName As String
                SheetsName = Sheets(CellNumber).name
                NoDataName = "No Data" & CellNumber
                If SheetsName = NoDataName Then
                    Columns("A:A").ColumnWidth = 30
                    Rows("1:1").RowHeight = 120.75
                    With Sheets(CellNumber).Range("A1")
                        .Value = "×"
                        .Font.Color = -16776961
                        .Font.Size = 50
                    End With
                Else
                    With Sheets(CellNumber).ChartObjects.Add(230, 50, 300, 200).Chart
                        .ChartType = xlXYScatterSmoothNoMarkers
                        .SetSourceData Source:=Sheets(CellNumber).Range("B5:C165")
                    End With
                    With Sheets(CellNumber).ChartObjects(1).Chart
                        .HasTitle = True
                        .ChartTitle.Characters.Text = BlockLineNumber & BlockColumnNumber & "-" & CellNumber & "の Vbg - Isd 特性"
                        .Axes(xlCategory).HasTitle = True
                        .Axes(xlCategory).AxisTitle.Characters.Text = "Vbg"
                        .Axes(xlValue).HasTitle = True
                        .Axes(xlValue).AxisTitle.Characters.Text = "Isd"
                        .SeriesCollection(1).Trendlines.Add Type:=xlLinear, DisplayEquation:=True, name:="線形近似"
                        .SeriesCollection(1).Trendlines(1).DataLabel.Select
                        Selection.NumberFormat = "0.000E+00"
                    End With
                    With Sheets(CellNumber).Range("A1")
                        .NumberFormat = "0.000E+00"
                        .ColumnWidth = 11.5
                    End With
                    Dim y As String
                    y = Sheets(CellNumber).ChartObjects(1).Chart.SeriesCollection(1).Trendlines(1).DataLabel.Text
                    Sheets(CellNumber).Range("A1").Value = y
                    Dim con As String
                    con = Left(Sheets(CellNumber).Range("A1"), 14)
                    con = Right(con, 10)
                    Sheets(CellNumber).Range("A1").Value = con
                    Dim di As Single
                    Columns("D:D").ColumnWidth = 11.5
                    Columns("D:D").NumberFormat = "0.000E+00"
                    For t = 5 To 164
                        di = Cells(t + 1, "c") - Cells(t, "c")
                        Cells(t, "D").Value = di / 0.5
                    Next
                End If
            Next
            ActiveWorkbook.SaveAs "D:\Desktopb\実験データ\sample1-" & BlockLineNumber & BlockColumnNumber, xlOpenXMLWorkbook
            ActiveWorkbook.Close SaveChanges:=True
        Next
    Next
Application.SheetsInNewWorkbook = Pro
End Sub
うまく計算ができなかった点についても追記です。 
近似曲線の傾きを利用したいので、上記のプログラムでは傾きを"A1"に書き込むようにしたつもりなのですが、 
プログラムを実行したあとファイルをひらいてみると"A1"に値が出ているブックとそうでないブックが出てきてしまいます。

また、上記のプログラムはまだ途中段階で、
最終的には、別のブックに全ての近似曲線の傾き、及びデータの微分値を一覧にした形で出力しようと思っています。

あつかましいお願いですが、
これらを含めて良い解決策あるいはアドバイスがあれば教えて頂きたいです。
（こっくさん） 2015/09/03(木) 16:47

長いので動かさず、ぱっと見ですが、A1セルにセットしている箇所は、ワークブックを省略していますよね？
これだとアクティブなブック内のシートを更新（後からブックを開くと、そっちがアクティブになる）してしまうので、ブックを明記してみてはどうでしょうか。
（???） 2015/09/03(木) 17:01

お返事ありがとうございます

確かにワークブックの指定は省略していたので
Workbook(2)を指定して試してみました！

しかし残念ながら結果は変わらなかったです、、

ちなみにDoEventsは使い方がいまいちわからなかったのですが、
ここでの使い方は”DoEventsの次の行の動作をゆっくりと行わせる命令”
ということでよかったでしょうか？

（こっくさん） 2015/09/03(木) 18:36

問題はA1セルだけですか？
そうならば、傾きは、SLOPE関数で求めればよいと思います。

（マナ） 2015/09/03(木) 19:12

 >>ここでの使い方は”DoEventsの次の行の動作をゆっくりと行わせる命令”

 あたらずとも遠からずです。実際には、処理を、ちょっと中休みというか、休憩して一服後、また開始と、こんなイメージです。
 じゃぁ、どこに入れたらいいかとなると、そこはある程度【かん】ですね。

 ちょっと気になるのは、やはり On Error Resume Next 等、エラートラップを多用しているところですね。
 主として、ファイルが存在しなかった場合の対処でしょうけど、あまり感心しません。
 開く前に、当該ファイルが存在するかどうか、これはいろんな方法がありますがＶＢＡ基本機能としてはDIR関数がありますので
 それをチェックして、有無によりロジック分岐をさせる。とくに、 Goto ラベル　などは使わないようにされたらいかがですか？
 (エラーとは関係のない部分での GoTo もありますが、これも感心しませんね）

 また、現在のコード、たとえば

                On Error Resume Next
                Workbooks.OpenText "D:\Desktop\実験データ・・・
                Sheets(1).Move After:=Workbooks(2).Sheets(CellNumber - 1)

 というところがありますよね。
 仮に、OpenTextで失敗したとする。でも、次のコードが実行される。これは、どのブックのSheet(1)かは別にして
 確実に実行されますね。これは具合悪いでしょ？

 さらに、このエラートラップのリセットは、そのあとの条件判定で、エラーが起こっていた場合、結局はリセットされていませんよね？

 やはり、エラートラップは廃止しましょう。

 あと、Workbooks(2) も気になります。ＰＣの環境（というかエクセルの環境）により、ブックと認識されるファイルが
 非表示で読みこまれている場合もあります。
 ですから Workbooks(2) といっても、必ずしも、想定しているブックではない場合があります。
 このような「環境依存」のコードではなく、きちんと目的のブックを指定されたほうがよろしいかと。

 再現テストは残念ながら、読みこむべきブックのデータが、どのようなものか、わからないので、できません。
 なので、ざっと眺めたレベルでのコメントです。

（β） 2015/09/03(木) 19:17

 とりあえず、すべてのWorkbooks.OpenText の下に DoEvents を入れてみると、どうなりますか？

（β） 2015/09/03(木) 19:30

 ちょっと本題からはそれますが。

 >>最近になってVBAを知り勉強を始めました。 
 >>マクロを組んで実験データを一気に処理させようと思いちょっと長めなマクロを組んで実行してみました。

 勉強を始めた段階であれば（に、かぎらずですが）長めのロジックを一挙にかかず、
 １機能、１機能にわけて、１つずつ書いて、１つずつ確認する。１つがＯＫになれば、次のブロックを追加して確認する。

 まずは、小さな単位で確実に機能するものを作り上げて、それらを結合していかれるほうが、結局は早いですよ。

（β） 2015/09/03(木) 19:34

 >当方理系の学生です。 
 現役理系学生の親をやっているものとして、
 >最近になってVBAを知り勉強を始めました。 
 最近がいつなのかによりますが、一年ぐらいを最近というなら、良くかけていると思いますよ。

 ファイルI/Oに　On　Error　Resume　Nextを使うのは　私は、良いと思いますよ！！
 もっとも私なら、違うコーディングをしますが、まあでもよいでしょう。
 ファイルI/Oのチェックで On Error ～　よりよい方法は私は知らないので　これを使うのはよいですが、
 問題は使い方ですね！！

 そしてもっとも気になるのは　既述ですが、GOTO文ですね！！

 Goto　20　とGoto　30　これを削除して同じ意味になるコードに書き直してみてください。

 新規ブックにて　以下のコードを実行してみてください。

 Option Explicit
 Sub test()
    Dim a As Long
    On Error Resume Next
    MsgBox "ok1"
    GoTo 10
    On Error GoTo 0
10: a = a / 0
    MsgBox Erl & "でエラーになっているのにプログラムは止まらない"
 End Sub

 プログラムのコードと実行した結果をよく調べてみてください。

 これと同じ現象が提示されたコード内でも起きる可能性があります。

 　
（　ichinose） 2015/09/03(木) 20:33

マナさん

 お返事ありがとうございます。

"グラフの概形を見る"かつ"傾きを調べる"事が目的でした。
グラフそのものは書けているのですが、傾きが指定した場所("A1")に出力できていない事が問題でした。

Slope関数というものは、はじめて知りました。
ざっと調べただけですが、まさに傾きを調べる関数ですね。
これを使えばうまくいくかもしれません。
今日はもう学校を出てしまったので明日ためしてみたいとおもいます。

 >>βさん

お返事ありがとうございます。

DoEventsについて分かりやすい解説をありがとうございます。
命令のイメージはつかめた気がします。
私の印象としてはグラフを操作する場合の負荷がおおきいのかな？という印象だったので、
With Sheets(CellNumber)ChartObjects(1).Chart
とある行の後ろにいくつかDoEventsをちりばめてみたのですがうまくいきませんでした。

今日は学校を出てしまったのですが、明日Opentxtの次の行にDoEventsをいれてみたいと思います。

エラートラップについて、おっしゃる通り、データファイルがなかった場合の対応策としてOn Error
Resume Next を使っていました。
また、ご指摘の通り改めてプログラムを見直すと、自分でもよくないなあと思う使い方でした。
アドバイスのとおりDIR関数で、うまく解決できそうなので、実践してみたいと思います。

Workbooksでのブック指定について "ブックと認識される非表示のファイル"というものがあることをはじめて知りました。
自分で開くブックをきちんと管理しておけばこの指定の仕方でも良いだろうと思っていたのですが、よくなかったのですね。
改めて指定は厳密に行おうと思います。

長いプログラムの書き方について恥ずかしながら、エクセルのVBAを知って1週間足らずの全くの初心者です。
今回書いたプログラムを書くにあたっては
"テキストファイルを開くマクロ"
"グラフを書くマクロ"
"保存をするマクロ"
といった具合に小さなマクロを作り、それぞれの動作が正確に行われていることを確認しました。
それらを1つずつ繋げて作ったのが今回のプログラムになります。
個別ではちゃんと動いていたのに繋げたとたんうまく動かなくなってしまったので、失敗の理由がわからず途方にくれていました。

たくさんのアドバイスをありがとうございます。
明日の結果はまだどうなるかわからないのですが、こちらご報告させていただきたいと思います。
もしお時間が許せばまたアドバイスをいただけるとうれしいです。

（こっくさん） 2015/09/03(木) 20:41

ichinoeさん

お返事ありがとうございます。
お誉めいただきうれしいです。
VBAは勉強を始めて1週間ほどです。
もともとC言語は教養として授業で教わっていたので、VBAもここまではわりとすんなりと来れました。

エラートラップについて、エラーの回避としてネットで検索して出てきた命令文がOnErrorGotoでした。
うまく動いていたのでそのまま使っていたのですが、今回はβさんのアドバイスにあったDIR関数でもうまく処理ができるようなので、そちらもためしてみたいと思います。

Gotoの使い方について頂いたコードがなんなのかコードをみただけでは、私にはわからなかったので、実際に動かしてみようと思います。
ただ今日は学校を出てしまったので明日実践してみたいと思います。
（こっくさん） 2015/09/03(木) 20:58

 特定のファイルからデータを読み込む処理をしてくれるOpentextメソッド、
 想定されるエラーは、何もファイルが存在しないというエラーだけではありません。
 他のエラーもありますし、想定外のエラーだって起こるかもしれません。
 そのようなエラーを拾ってくれるOn Error ～はプログラムの完成度を高めるという観点からだと
 ファイルをオープンするという処理にははずせないステートメントです。
 もう長いことVBAを含めたいわゆるBasicと呼ばれる言語でプログミングをしてきましたが、
 この　On Error ～　ステートメントを書かない商品はなかったと思います。

 ファイルI/Oに関しては、On Error ～ステートメントは　必要不可欠　ということは
 覚えておいてください。

 今回は　使い方が問題なだけです。

 ただ、今回のこっくさんの不具合を発見するための手段として、On Error ～ステートメントを外してみる
 （代わりにDir関数で対応する）という試みは　やる価値はあるかもしれません。

 これによりもしかしたら・・ですが、私が提示したコードの意味もわかっていただけるかもしれません。

 でも不具合がみつかり、修正し、完成されたコードには　On Error ～ステートメントは必要ですよ！！

 >Gotoの使い方について 頂いたコードがなんなのか

 提示したコードはGotoの使い方でなく　Goto文の弊害です。
 Goto文は使わなくてもプログラムは作れます。

 Goto文は使わないという方針でプログラミングを考えてください。

（　ichinose） 2015/09/04(金) 05:39

 >>でも不具合がみつかり、修正し、完成されたコードには　On Error ～ステートメントは必要ですよ！！

 ichinose大師匠のご見解ですが、あえて反論します。
 実際には、コメントは

 >>この　On Error ～　ステートメントを書かない商品はなかったと思います。

 「商品」ととらえておられるご発言で、商品としては、後述のように、（ものによっては）理解していますが
 基本的には、むやみやたらの エラートラップ（バイパス）は使うべきではないと考えています。

 確かに、ファイルそのものは存在するけど、様々な原因で読めない場合もあります。
 だけど、それを言い出せば、エクセルの世界です。たとえばセルにエラー値が（計算式の結果だけではなく
 外部データのコピペ、あるいは何かしらの障害も含めて）入っている場合があります。
 それを考えると、そのセルの参照にもエラートラップが必要になるという理屈になります。

 等々、エクセルの世界ですから、あれも、これも　エラーの可能性を含みます。その対処をするとなると
 もう面倒だからと言って、（β） 2015/09/03(木) 19:17 で、ちょっとふれましたが、先頭に１行、On Error Resume Next と書くという
 本末転倒の発想を持つ人もでてくるわけです。

 ましてや、今回のテーマは、（こっくさん） ご自身が、自分で作業するためのコードです。
 ここでエラーになった場合、まず、連結して作り上げたファイルフルパス文字列が正しいのかどうか
 そこの検証で頭を悩ませます。DIR等でチェックしておけば、そこは、デバッグ作業からはずすことができるわけです。
 また DIRで見つからなければ、今回の場合は ループ制御のインデックスですけど、それを組み合わせたものが悪い、
 つまり、ファイルが読める読めない、という問題ではなく、ループ制御インデックスの扱いのバグという切り分けができるわけです。

 「商品」としての性格を持つコードについては、昔、ベータも、そういった仕事に携わっていましたから理解できます。
 これは、エラーを回避するという意味合いよりも、
 ・エラーが発生した場合に、インタラクティブなプログラム実行環境では、だいたい、いわゆる「デバッグ画面」がでる。
 　そこで、わけのわからないエンドユーザに、めちゃめちゃなことをされると、リカバリーが大変になる。
 　たとえば、そこで中断してくれず、先に進めて、またエラー、そのうちに、エラーにはならず（おかしな状態を踏まえた）ノーマルエンド　となり
 　後日、データがめちゃめちゃになってクレームが入る。もう、何が原因かがわからなくなる。
 ・あるいは、処理中断すると、エンドユーザから保守窓口に、緊急対応しろ！！　という連絡が来る。
 　これを、エラーートラップで、「予期しないエラーが発生しました。これこれこれの情報を受付デスクまでメールで連絡願います」
 　なんてメッセージを出しておくと、結構、「クレーム」にはならず「連絡」になるケースがあり、また
 　「今すぐ」ではなく、「まぁ、待とうか」という気持ちになるケースがあると、これはベンダサイドの悪知恵ですけど。

（β） 2015/09/04(金) 07:10

 >むやみやたらの エラートラップ（バイパス）は使うべきではないと考えています。
 それは、同感ですが・・・。
 そのむやみにの　中身が違うのでしょうね！！

 On Errorに関しては、記述どおりの意見です。

 今回は、On  Error　～はずしてバグを探るという方法には、賛成です。

 この方法で　バグ発見をすることを優先させましょう
 ご自分で努力されている学生さんにみえるので、
 バグ発見を遅らせたくはないので・・・。

 この事では　何度か意見交換をしてきた経験があります。
 私が近い内に別スレッドを立てますのでそちらで意見交換させてください。

（　ichinose） 2015/09/04(金) 08:09

こんにちは

現在のコードは

sample1-12-1.txt～sample1-89-4.txt の256テキストファイルを処理し、
sample1-12.xlsx～sample1-89.xlsxの64ブックを作成するコードになっているようですが、

Workbooks.OpenTextでエラーになる場合は、
"No Data" & CellNumber
というシートを作り、セルA1に×をセット。

エラーにならない場合は、読み込んだテキストデータをコピー（Moveになっている）して
CellNumber
というシート名にし、Range("B5:C165")にグラフを作成し、
セルA1に

   Sheets(CellNumber).ChartObjects(1).Chart.SeriesCollection(1).Trendlines(1).DataLabel.Text
をセットする。

その他の書式等の処理も有りますが全体的にはこんな感じでしょうか？

（ウッシ） 2015/09/04(金) 08:58

こんにちは

こんな感じで、

Sub test()

    Dim Pro               As Integer
    Dim BlockLineNumber   As Integer
    Dim BlockColumnNumber As Integer
    Dim CellNumber        As Integer
    Dim t                 As Long
    Dim tBk               As Workbook
    Dim s                 As Workbook
    Dim di                As Single

    Pro = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1

' Application.ScreenUpdating = False

    On Error GoTo Err_Line

    For BlockLineNumber = 1 To 8
        For BlockColumnNumber = 2 To 9
            Set tBk = Workbooks.Add
            For CellNumber = 1 To 4
                Workbooks.OpenText "D:\Desktop\実験データ\sample1-" & BlockLineNumber & BlockColumnNumber & "-" & CellNumber & ".txt", DataType:=xlDelimited, Space:=True
                Set s = ActiveWorkbook
                If Err.Number <> 0 Then
                    If CellNumber = 1 Then
                        tBk.Sheets(1).Name = "No Data" & CellNumber
                    Else
                        tBk.Worksheets.Add After:=tBk.Sheets(CellNumber - 1)
                        tBk.Sheets(CellNumber).Name = "No Data" & CellNumber
                    End If
                    With tBk.Sheets("No Data" & CellNumber)
                        .Columns("A:A").ColumnWidth = 30
                        .Rows("1:1").RowHeight = 120.75
                        With .Range("A1")
                            .Value = "×"
                            .Font.Color = -16776961
                            .Font.Size = 50
                        End With
                    End With
                Else
                    If CellNumber = 1 Then
                        s.Sheets(1).Move After:=tBk.Sheets(1)
                        Application.DisplayAlerts = False
                        tBk.Sheets(1).Delete
                        Application.DisplayAlerts = True
                    Else
                        s.Sheets(1).Move After:=tBk.Sheets(CellNumber - 1)
                    End If

                    With tBk.Sheets(CellNumber)
                        With .ChartObjects.Add(230, 50, 300, 200).Chart
                            .ChartType = xlXYScatterSmoothNoMarkers
                            .SetSourceData Source:=.Range("B5:C165")
                        End With
                        With .ChartObjects(1).Chart
                            .HasTitle = True
                            .ChartTitle.Characters.Text = BlockLineNumber & BlockColumnNumber & "-" & CellNumber & "の Vbg - Isd 特性"
                            .Axes(xlCategory).HasTitle = True
                            .Axes(xlCategory).AxisTitle.Characters.Text = "Vbg"
                            .Axes(xlValue).HasTitle = True
                            .Axes(xlValue).AxisTitle.Characters.Text = "Isd"
                            .SeriesCollection(1).Trendlines.Add Type:=xlLinear, DisplayEquation:=True, Name:="線形近似"
                            .SeriesCollection(1).Trendlines(1).DataLabel.Select
                            Selection.NumberFormat = "0.000E+00"
                        End With
                        With .Range("A1")
                            .NumberFormat = "0.000E+00"
                            .ColumnWidth = 11.5
                        End With

                        .Range("A1").Value = _
                            tBk.Sheets(CellNumber).ChartObjects(1).Chart.SeriesCollection(1).Trendlines(1).DataLabel.Text

                        .Range("A1").Value = Right(Left(.Range("A1"), 14), 10)

                        .Columns("D:D").ColumnWidth = 11.5
                        .Columns("D:D").NumberFormat = "0.000E+00"
                        For t = 5 To 164
                            di = .Cells(t + 1, "c") - .Cells(t, "c")
                            .Cells(t, "D").Value = di / 0.5
                        Next
                    End With
                End If
            Next
            tBk.SaveAs "C:\Desktopb\実験データ\sample1-" & BlockLineNumber & BlockColumnNumber, xlOpenXMLWorkbook
            tBk.Close SaveChanges:=True
        Next
    Next
'    Application.ScreenUpdating = True
    Application.SheetsInNewWorkbook = Pro
    Exit Sub
Err_Line:
    MsgBox Err.Description
    Resume Next
End Sub

エラーになった都度、内容を確認してデバッグしていくといいと思います。

（ウッシ） 2015/09/04(金) 09:47

遅くなってしまい申し訳ありません。
すぐに検証してみたかったんですが実験がたてこんでしまっていて、、

みなさんに頂いたアドバイスをもとに以下のようにプログラムを組んでみました

Sub 一括解析改良版()

' Application.ScreenUpdating = False

Dim FileName As String
Dim CellNumber As Integer
Dim BookName As String
Dim BlockLineNumber As Integer
Dim BlockColumnNumber As Integer
Dim Pro As Integer
Dim SheetsName As String
Dim NoDataName As String
Dim con As String
Dim di As Single
Dim y As String
Dim t As Integer

Pro = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1

'各ブロックごとに処理

    For BlockLineNumber = 1 To 8
        For BlockColumnNumber = 2 To 9

'STEP1_データを1ブロックぶん開く

    '1~4番セルのデータを開きブックを1つにまとめるて名前を付けて保存する。
            BookName = "sample1-" & BlockLineNumber & BlockColumnNumber
            For CellNumber = 1 To 4
            FileName = Dir("D:\Desktop\実験データ\" & BookName & "-" & CellNumber & ".txt")
                If CellNumber = 1 Then
                    If FileName = BookName & "-" & CellNumber & ".TXT" Then
                    'On Error Resume Next
                    Workbooks.OpenText "D:\Desktop\実験データ\" & BookName & "-" & CellNumber & ".txt", DataType:=xlDelimited, Space:=True
                    DoEvents
                Else
                    Workbooks.Add.Sheets(1).name = "No Data" & CellNumber
                End If
                ActiveWorkbook.SaveAs "D:\Desktop\実験データ\" & BookName, xlOpenXMLWorkbook

                Else
                    If FileName = BookName & "-" & CellNumber & ".TXT" Then
                        'On Error Resume Next
                        Workbooks.OpenText "D:\Desktop\実験データ\" & BookName & "-" & CellNumber & ".txt", DataType:=xlDelimited, Space:=True
                        DoEvents
                        Sheets(BookName & "-" & CellNumber).Move After:=Workbooks(BookName).Sheets(CellNumber - 1)
                    Else
                        Worksheets.Add After:=Workbooks(BookName).Sheets(CellNumber - 1)
                        Workbooks(BookName).Sheets(CellNumber).name = "No Data" & CellNumber
                    End If
                End If
            Next

'STEP2_各シートにグラフを作成

            For CellNumber = 1 To 4
                'NoDataへの対処
                SheetsName = Sheets(CellNumber).name
                NoDataName = "No Data" & CellNumber
                If SheetsName = NoDataName Then
                    Columns("A:A").ColumnWidth = 30
                    Rows("1:1").RowHeight = 120.75
                    With Sheets(CellNumber).Range("A1")
                        .Value = "×"
                        .Font.Color = -16776961
                        .Font.Size = 50
                    End With

                Else
                    'グラフ作製
                    With Sheets(CellNumber).ChartObjects.Add(230, 50, 300, 200).Chart
                        .ChartType = xlXYScatterSmoothNoMarkers
                        .SetSourceData Source:=Sheets(CellNumber).Range("B5:C165")
                    DoEvents
                    End With

                    With Sheets(CellNumber).ChartObjects(1).Chart
                        .HasTitle = True
                        .ChartTitle.Characters.Text = BlockLineNumber & BlockColumnNumber & "-" & CellNumber & "の Vbg - Isd 特性"
                        .Axes(xlCategory).HasTitle = True
                        .Axes(xlCategory).AxisTitle.Characters.Text = "Vbg"
                        .Axes(xlValue).HasTitle = True
                        .Axes(xlValue).AxisTitle.Characters.Text = "Isd"
                        DoEvents
                    '近似曲線の追加
                        .SeriesCollection(1).Trendlines.Add Type:=xlLinear, DisplayEquation:=True, name:="線形近似"
                        DoEvents
                        .SeriesCollection(1).Trendlines(1).DataLabel.Select
                        DoEvents
                        Selection.NumberFormat = "0.000E+00"
                        DoEvents
                    End With

                    '近似曲線の傾きの書き出し
                    With Workbooks(BookName).Sheets(CellNumber).Range("A1")
                        .NumberFormat = "0.000E+00"
                        .ColumnWidth = 11.5
                    End With
                    DoEvents
                    y = Workbooks(BookName).Sheets(CellNumber).ChartObjects(1).Chart.SeriesCollection(1).Trendlines(1).DataLabel.Text
                    Workbooks(BookName).Sheets(CellNumber).Range("A1").Value = y
                    DoEvents
                    con = Left(Sheets(CellNumber).Range("A1"), 14)
                    con = Right(con, 10)
                    Workbooks(BookName).Sheets(CellNumber).Range("A1").Value = con

                    'Slopeを使った傾きの書き出し
                    With Workbooks(BookName).Sheets(CellNumber).Range("B1")
                        .NumberFormat = "0.000E+00"
                        .ColumnWidth = 11.5
                        .Value = Application.WorksheetFunction.Slope(Workbooks(BookName).Sheets(CellNumber).Range("C5:C165"), Workbooks(BookName).Sheets(CellNumber).Range("B5:B165"))
                    End With

                    '微分操作
                    Columns("D:D").ColumnWidth = 11.5
                    Columns("D:D").NumberFormat = "0.000E+00"
                    For t = 5 To 164
                        di = Cells(t + 1, "c") - Cells(t, "c")
                        Cells(t, "D").Value = di / 0.5
                    Next
                End If
                DoEvents
            Next
            Workbooks(BookName).Close SaveChanges:=True
        Next
    Next
'    Application.ScreenUpdating = True
Application.SheetsInNewWorkbook = Pro
End Sub

結果から報告させていただくと、改良したプログラムを動作させても以前のままと変わらず、すべてのブックの"A1"に近似曲線の傾きを表示させることはできませんでした。

ただし、SLOPE関数で"B1"に傾きを表示させることはできました。

近似曲線の傾きから表示できないのはまだ納得がいっていませんが、１つの目的であった傾きの表示には成功したので、Slope関数を用いて解析プログラムを利用したいと思います。
たくさんのアドバイスをありがとうございました。
今後もVBAについてたくさん勉強していこうと思うので、またわからないことがあったとき、ここに書き込みに来ることもあると思うのでその時はよろしくお願いします。

また、ほかにも試みたこと、およびその結果も御報告させていただきます
・Application.ScreenUpdatingの有効、無効によらず結果は変わりませんでした。
・On Error Resume Nextの有効、無効によらず結果は変わりませんでした。
・DoEvents上記のプログラムにもあるように様々なところにちりばめてみましたが結果は変わりませんでした。

またichinoseさんに頂いたコードですが、以下の2つのコードを実行してみました。

Option Explicit

 Sub test1()
    Dim a As Long
    On Error Resume Next
     MsgBox "ok1"
    On Error GoTo 0
     a = a / 0
    MsgBox Erl & "でエラーになっているのにプログラムは止まらない"
 End Sub

 Option Explicit
 Sub test2()
    Dim a As Long
    On Error Resume Next
    MsgBox "ok1"
    GoTo 10
    On Error GoTo 0
10: a = a / 0
    MsgBox Erl & "でエラーになっているのにプログラムは止まらない"
 End Sub

 Option Explicit

test1ではエラーメッセージが表示されるのに対して、test2では「10でエラーになっているのにプログラムは止まらない」と表示されました。

そこで以下のようなプログラムも組んでみました。

 Sub test3()
    Dim a As Long
    On Error Resume Next
    MsgBox "ok1"
    GoTo 10
10: On Error GoTo 0
    a = a / 0
    MsgBox Erl & "でエラーになっているのにプログラムは止まらない"
 End Sub

このプログラム結果はエラーになりました。

このことからGoTo文の弊害とは
"GoTo文を用いてOn Error Goto 0をよけてしまうと以降で想定していないエラーが発生しても何事もなかったかのようにプログラムが進んでしまうので注意しなければいけない"
ということでよかったでしょうか？
（これだと"エラートラップではGotoを使わないほうがいい"という結論になってしまうので、ichinoseさんがおっしゃりたかったこととは異なっているかもしれませんが、、)

ウッシさんに頂いたプログラムも動作させてみたのですが、ポップアップしたメッセージウィンドウをうまく消せなかったので2回目以降は動かすのが怖くて、申し訳ないと思いつつもデバックもしないままになっております。
ごめんなさい、、
もう少しVBAに詳しくなってからデバックに挑戦したいと思います。
（こっくさん） 2015/09/04(金) 18:19

 >On Error Goto 0をよけてしまうと以降で想定していないエラーが発生しても何事もなかったかのようにプログラムが進んでしまうので注意しなければいけない"
 弊害と申し上げたのはこのことです。

 >エラートラップではGotoを使わないほうがいい"という結論
 なるほど、でも私が申し上げたいのは、何であれ　GOTO文は使わない　という結論だったのです。

 この掲示板でも読みにくいGOTO文を使った例は数年に一度ぐらいは見かけます。
 逆に言えば、それほど、Goto文を使わないコードが市民権を得ていることになります。
 何十年も前に提唱された構造化プログラミングの考え方が今も受け継がれているのだと思います。

 プログラムの流れは、順構造、分岐構造　繰り返し構造　の三構造で成り立ち、
 これは、GOTO文を使わなくても実現できる、逆にGOTO文を使うとロジックが理解しにくくなる。

 実際には、構造化プログラミングで検索したりしてみてください。もっと詳しく書かれているサイトがあると思いますし、これを実現する考え方を記述した書物もあると思います。

 実は、今回の件は、普段GOTO文を見慣れていない私は　最初気が付きませんでした。

 私は、コード全体を精査しているわけではありませんが、on error goto 0 を何気に飛ばしているので

 >For CellNumber = 1 To 4 
 >               Dim SheetsName As String
 >               Dim NoDataName As String
 >               SheetsName = Sheets(CellNumber).name
 以降続く

 条件によっては、ここがエラーで止まらない場合があるので　そこに原因があるかもしれない
 と思い、同様のコード例を提示しました。
 今回は、On Errorをはずして結果が変わらないとなると、 原因はまだ突き止められていないようですが。

 Gotoを使わなければこのようなミスも少ないと思いますよ。

 繰り返しますが、
 >エラートラップではGotoを使わないほうがいい"という結論
 ではなく、Goto文を使わないコーディングをする　です。

 エラートラップの件とは　切り離してください。

 これはこれ、あれはあれです。

 私がGoto文を使ったのは、先のプログラムの流れの　分岐構造、繰り返し構造
 を構築するのに　Goto文を使わないと実現できない文法になっていた言語を使っていた時だけです。
 （N88Basic　アセンブラ　Fortran77）

 VBAは、Goto文なしでもコードは書けます。

 Goto文論争を行っているサイトをちょっとまえまでよく見かけました。
 （Goto賛成・反対論争です）

 確か熟練者の中には、わかりやすくGoto文を使う方もいます。

 が、プログラミングを始めて間もないのなら、まずは、Goto文なしでコードを書くことから
 始めるほうが良いですよ！！

 本題ですが、今度は　現象が再現する簡単な入力データ例を提示されてみては
 いかがですか？

（　ichinose） 2015/09/05(土) 08:53

とりあえず都度シートをアクティブにすれば成功しそうです。
（原因はわかりませんが）

（マナ） 2015/09/05(土) 10:02

このような現象ではないかと思われます。

 他板ですが、これも同じ原因かも。
http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=171347&rev=0

 ・データはRange("B5:C165")に適当なものを用意してください。
 ・★の行によっては、A1セルに回帰式が表示されないことがあります。

 Sub test()
    Dim ws As Worksheet
    Dim cht As Chart
    Dim ser As SeriesCollection
    Dim trd As Trendline

    For Each ws In Worksheets
        ws.Activate     '★
'        ActiveWindow.ScrollRow = 100   '★

        With ws.ChartObjects.Add(230, 50, 300, 200).Chart
            .ChartType = xlXYScatterSmoothNoMarkers
            .SetSourceData Source:=ws.Range("B5:C165")

            Set trd = .SeriesCollection(1).Trendlines.Add( _
                        Type:=xlLinear, _
                        DisplayEquation:=True)

            Application.Wait Now + TimeValue("0:00:01") '★

            ws.Range("A1").Value = trd.DataLabel.Text

' ActiveWindow.ScrollRow = 1 '★

        End With
    Next

 End Sub

（マナ） 2015/09/05(土) 11:20

遅くなってしまいすみません

ichinoseさん

確かに今回のプログラムでは、実際にGotoを使わなくても同様に動作するプログラムを組むことができました。
また以前のプログラムを見てみると、Gotoを使って行を移動してしまう読みづらいプログラムだな、と思ったのでこれからは使わずにプログラムを組むように心がけたいと思います。

同じ現象の再現は取れてはいないのですが、、
Sub txtファイル作製()

Dim a As Single
Dim CN As Integer
Dim BookName As String
Dim BLN As Integer
Dim BCN As Integer
Dim Pro As Integer
Dim X As Single
Dim y As Single

Pro = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1

PlaceOfData = "D:\Desktop\VBA検証\"

    For BLN = 1 To 8
        For BCN = 2 To 9
            BookName = BLN & BCN

                For CN = 1 To 4
                    With Workbooks.Add
                    .Sheets(1).name = BookName & "_" & CN
                    ActiveWorkbook.SaveAs PlaceOfData & BookName & "_" & CN, xlText
                    a = (-1) * (Int(Rnd * 100)) / 1000000
                    For X = 1 To 160
                        Workbooks(BookName & "_" & CN).Sheets(BookName & "_" & CN).Range("A" & X).Value = X
                        y = a * X + 0.003 + Rnd / 50000
                        Workbooks(BookName & "_" & CN).Sheets(BookName & "_" & CN).Range("B" & X).Value = y
                    Next
                    Workbooks(BookName & "_" & CN).Close SaveChanges:=True
                    End With
                Next

        Next
    Next
Application.SheetsInNewWorkbook = Pro

End Sub

これで似たようなファイルが作れます。

マナさん頂いたURLの現象と私のプログラムで起きた現象が同一のものなのかはいまいちわからなかったのですが、
"都度シートをアクティブにする"というのをプログラムに組み込んでみたところ近似曲線の傾きを出力することができました。
原因はまだ私もわかりませんが、取りあえずですが、当初の狙いのままのプログラムが動くようになったのですっきりした気持ちです。
ありがとうございます。

（こっくさん） 2015/09/07(月) 20:49

 以前、同種と思われる質問がありました。

 『VBAでグラフの自動更新を行うが凡例が正しく設定されない』（チャッコロ）
[[20140428175241]]

 相違点は、今回が、
 　Application.ScreenUpdating = False　がコメントアウトされていること、
 　都度シートをアクティブにすると成功したこと

 同じなのは
 　chart関連で、ステップ実行だとうまく行くこと

 ユーザーには知らされていない「描画に関する仕様」に基づく現象、と云う気がします。

（半平太） 2015/09/18(金) 09:10

コメント返信：

[ 一覧(最新更新順) ]

[[20150903144924]] 『プログラム全体で実行するとうまくいかない』（こっくさん） ページの最後に飛ぶ

[[20150903144924]]　『プログラム全体で実行するとうまくいかない』（こっくさん）　ページの最後に飛ぶ