【VBA】複数シートのデータを順番に計算して、結果を別ブックのシートに同じ順番に書き込む

Question

【VBA】複数シートのデータを順番に計算して、結果を別ブックのシートに元データのシートと同じ順番に書き込む
VBAで回帰分析を行うなシステムを作っています。
現在、一つのシートをからデータを読み込みそのシートの隣に結果用シートを作る形で作ってみました（ここまではうまくいっております）。ここから、データが複数シートあるとしてそれらを全部計算して、結果を別ブックに元データと同じ順番で吐き出すようにしたいと思っております。
基本的には、各シートに行う処理は同じです。
どなたかよろしくご教授ください。
よろしくお願いいたします。

###該当（元の）のソースコード
※以下のコードは問題なく走りました。

Sub regression()
Dim myFileName(1) As String '処理するファイル名
Dim ws(1) As Worksheet
Dim Ya As String 'Y
Dim Xa As String 'X
Dim SName As String 'シート名

Ya = "A2:A101" 'Y範囲
Xa = "B2:B101" 'X範囲
SName = "Sheet1" 'シート名
         
'ファイル選択処理
myFileName(1) = Application.GetOpenFilename(Title:="ファイル選択", filefilter:="Excelブック(*.xlsx),*.xlsx)")
'キャンセル時の処理
If myFileName(1) = "False" Then Exit Sub
'処理ファイルを開く
Workbooks.Open Filename:=myFileName(1)
'パスを除いたファイル名を取得
myFileName(1) = Mid(myFileName(1), InStrRev(myFileName(1), "\") + 1)

'分析用シート名のセット
Set ws(1) = Workbooks(myFileName(1)).Sheets(ShName)
'出力用シート名の設定
myFileName(0) = myFileName(1) & "分析結果" & ThisWorkbook.Sheets.Count

'分析ツールの実行
Application.Run "ATPVBAEN.XLAM!Regress", ws(1).Range(Ya), ws(1).Range(Xa), False, False, , myFileName(0), False, False, False, False, , False
'出力用シート名のセット
Set ws(0) = Workbooks(myFileName(1)).Sheets(myFileName(0))
'シートの移動
ws(0).Move Before:=ThisWorkbook.Sheets(1)
'分析用ファイルの終了
Workbooks(myFileName(1)).Close savechanges:=False
End Sub

###試したこと
① Sheets(Array("Sheet1", "Sheet2")).Selectを使いましたが、その前に計算されたシートに上書きされてしまいました。
② For Each ws(1) In Workbook
ws(1).Activate
Next ws(1)
を上のコードの
Set ws(1) = Workbooks(myFileName(1)).Sheets(ShName)
～ws(0).Move Before:=ThisWorkbook.Sheets(1)
まで挟んで見ましたが、For Each ws(1) In Workbookで「コンパイルエラー：Workbookが定義されていません」となりました。

###補足情報(言語/FW/ツール等のバージョンなど)
Excel2016

Answer 1

わざわざ分析ファイルに出力シートを作成してあとから移動するのではなく、最初から出力用ブックに作成してはどうでしょうか？

ファイルを開く際に使うOpeen関数は開いたブックを返してくれます。
同様にシートを追加する際のWorkSheets.Add関数も作成したシートを返してくれます。
これらもうまく活用すれば、比較的シンプルなコードで目的の動作が実現できると思いますよ。

以下は上記を反映したサンプルコードです。

Sub regression2()
    Dim myFileName(1) As String '処理するファイル名
    Dim Ya As String 'Y
    Dim Xa As String 'X
    Dim SName As String 'シート名
    
    Ya = "A2:A101" 'Y範囲
    Xa = "B2:B101" 'X範囲
    SName = "Sheet1" 'シート名
    
    'ファイル選択処理
    myFileName(1) = Application.GetOpenFilename(Title:="ファイル選択", filefilter:="Excelブック(*.xls),*.xls)")
    
    'キャンセル時の処理
    If myFileName(1) = "False" Then Exit Sub
    
    '処理ファイルを開く
    Dim wbRead As Workbook  '読み込みブック
    Set wbRead = Workbooks.Open(myFileName(1))
    
    'パスを除いたファイル名を取得
    myFileName(1) = Mid(myFileName(1), InStrRev(myFileName(1), "\") + 1)
    
    '出力用ブック(現在のブック)
    Dim wbOut As Workbook  '読み込みブック
    Set wbOut = ThisWorkbook
    
    Dim wsRead As Worksheet '読み込みシート
    Dim wsOut As Worksheet  '出力シート
    For Each wsRead In wbRead.Worksheets    '読み込みブックのすべてのシートをループ処理
    
        '出力用ブックに出力用シートを追加
        Set wsOut = wbOut.Worksheets.Add(, wbOut.Sheets(wbOut.Sheets.Count))
        
        '出力用シート名の設定
        wsOut.Name = myFileName(1) & "分析結果" & wbOut.Sheets.Count
        
        '分析ツールの実行
        Application.Run "ATPVBAEN.XLAM!Regress", wsRead.Range(Ya), wsRead.Range(Xa), False, False, , wsOut.Range("A1"), False, False, False, False, , False
    
    Next
    
    '分析用ファイルの終了
    wbRead.Close savechanges:=False
    
End Sub

参考になれば幸いです。

Comments

[teku]

ご回答ありがとうございます。
下から3行目のNextにwsReadをつけてコードを走らせてみたのですが、データの分析ファイルにシートが三枚追加されて最後のシートにだけ結果が出力されています。

どこか誤植等があるのでしょうか。ご教示いただければ幸いです。

[jawa]

コードを見ないことには何とも言えませんが、出力用シートが分析用ファイル（読み込みファイル）に作成されるということは、wbOutがwbReadと同一になっているように思えます。

提示したサンプルコードは当方の環境で一応の動作確認をしたものですが、出力用ブックのワークシート関数として実装していました。
このためThisWorkbookは当然に出力用ブックを指していたのですが、これが別のブックを指すとなると実装箇所の違いなどが原因かもしれません。

対策としては、
・関数を標準モジュールなどでなく出力用ブックのワークシート関数として実装する
・ThisWorkbookを使わず、出力ブックを明示的に指定する
などで改善するかもしれません。

もしかしたら
・分析用ファイルを開く前に`Set wbOut = ThisWorkbook`をセットする
だけでも大丈夫かもしれません。
お試しください。

Answer 2

Workbook は定義されていない変数なので、そのエラーが出ています。
ワークシート分ループするならば、ループ部分はこんな感じになると思います。

' 未定義の Workbook ではなく、現在処理中の Workbook を指定。
'For Each ws(1) In Workbook
For Each ws(1) In Workbooks(myFileName(1))

  ws(1).Activate

  ' For Each で取れているので、Set ws(1) は不要。
  '分析用シート名のセット
  'Set ws(1) = Workbooks(myFileName(1)).Sheets(ShName)
  '出力用シート名の設定
  myFileName(0) = myFileName(1) & "分析結果" & ThisWorkbook.Sheets.Count
  '分析ツールの実行
  Application.Run "ATPVBAEN.XLAM!Regress", ws(1).Range(Ya), ws(1).Range(Xa), False, False, , myFileName(0), False, False, False, False, , False
  '出力用シート名のセット
  Set ws(0) = Workbooks(myFileName(1)).Sheets(myFileName(0))
  'シートの移動
  ws(0).Move Before:=ThisWorkbook.Sheets(1)  

Next ws(1)

Comments

[teku]

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

ステップインで実行させていただきましたが、
For Each ws(1) In Workbooks(myFileName(1))
の所で、「オブジェクトはこのプロパティまたはメソッドをサポートしていません」
と出てしまいます。
お手数ですが、ご教示いただけませんでしょうか。

[tukuroku]

worksheets プロパティが抜けてました。
以下のようにしてみて下さい。

```vba
'For Each ws(1) In Workbooks(myFileName(1))
' 　　　　　　　　　　　　　　　　　　　　　　↓
For Each ws(1) In Workbooks(myFileName(1)).worksheets
```

[teku]

ありがとうございます。
先ほどのエラーは出なくなりました。
２つのシートにデータを入れ試したのですが、実行結果のシートが１つしか出てきません。
それぞれのシートに出るようにしたいのですが、どうしたらよいでしょうか。
ご教示いただけたら幸いです。

[tukuroku]

出力用シートの名称が固定のためと見られます。
ループ前にカウンタ用の変数を初期化しておいて、ループ内でインクリメントしてシート名につけるとよいとおもいます。

```vba

dim wsNo as long
wsNo = 0

For Each ws(1) In Workbooks(myFileName(1))

'中略

'出力用シート名の設定
'myFileName(0) = myFileName(1) & "分析結果" & ThisWorkbook.Sheets.Count
wsNo = wsNo + 1
myFileName(0) = myFileName(1) & "分析結果" & wsNo

' 後略

```

[teku]

ご回答ありがとうございます。
返信遅れまして申し訳ございません。実際に試してみたのですが、結果は変わらないようです。
何かお気づきの点がありましたらよろしくお願いいたします。