質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.58%

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

受付中

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 5,691

score 6

【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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

0

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)

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/08/08 18:01

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

    キャンセル

  • 2017/08/08 18:11

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

    ```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

    ' 後略

    ```

    キャンセル

  • 2017/08/10 14:37

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

    キャンセル

0

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

ファイルを開く際に使う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


参考になれば幸いです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/08/10 14:19

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

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

    キャンセル

  • 2017/08/10 16:45 編集

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

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

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

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.58%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

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