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

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

ただいまの
回答率

90.50%

  • VBA

    2317questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

別のブックにシートをコピーするする際のインデックス有効範囲エラー)¥について

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 261

SugiuraY

score 202

現在ブックがA.xlsmとB.xlsxがあります。
A.xlsmがマクロ実行用のエクセルです。

1) A.xlsmのCells(r,1)の文字列のブックB.xlsxを開く(B.xlsxには(r,2)のシート名が存在します)
2) A.xlsmのCells(r,2)の文字列の新しいブックC.xlsxを作成する
3) B.xlsxのシートをC.xlsxの同じシート名にコピーする

*具体的にわかりやすく申し上げれば
A.xlsm (r,1) 天気 (r,2)20190227
B.xlsxには20190227というシートが存在しており、(1,1)に晴れと記載されている
C.xlsxに晴れというブック名を付して、B.xlsxの同じシート名の晴れという内容を
コピーしてきたい

ということになります。ループになっているの少しわかりづらいのですが
上記を意図したコードが"インデックス有効範囲エラー"がでてしまうのですが
原因と解決方法を教えてください。

宜しくお願い申し上げます。

Sub fileOpenAndCreate()
  Dim fileName As String
  Dim r As Long
  Dim wb As Workbook
  Dim oldPath As String
  Dim newPath As String

  r = 2
  While Cells(r, 1) <> ""
    oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & Cells(r, 1).Value
    newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & Cells(r, 2).Value

    Workbooks.Open (oldPath) '既にWBをOpenでも動作する仕様を確認
    Worksheets(Cells(r, 2).Value).Activate
    Set wb = Workbooks.Add
    wb.SaveAs (newPath)
    Worksheets(1).Name = Cells(r, 2).Value

    Workbooks(oldPath).Worksheets(Cells(r, 1).Value).Copy After:=Workbooks(newPath).Worksheets(Cells(r, 1).Value)


    r = r + 1
  Wend



End Sub

修正後のコード

Sub fileOpenAndCreate()
  Dim fileName As String
  Dim r As Long
  Dim oldPath As String
  Dim newPath As String

  Dim nWb As Workbook
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim tWs As Worksheet
  Dim nWs As Worksheet


  Set tWs = Worksheets("実行シート")

  r = 2
  While Cells(r, 1) <> ""
    oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & tWs.Cells(r, 1).Value
    newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & tWs.Cells(r, 2).Value

    'old------------
    Set oWb = Workbooks.Open(oldPath)  '既にWBをOpenでも動作する仕様を確認
    Set oWs = oWb.Worksheets(tWs.Cells(r, 2).Value)

    'new------------
    Set nWb = Workbooks.Add
    nWb.SaveAs (newPath)
    Set nWs = nWb.Worksheets(1)
    nWs.Name = tWs.Cells(r, 2).Value


    oWs.Copy After:=nWs(tWs.Cells(r, 2).Value)


    r = r + 1
  Wend



End Sub

再修正コード

Sub fileOpenAndCreate()
  Dim fileName As String
  Dim r As Long
  Dim oldPath As String
  Dim newPath As String

  Dim nWb As Workbook
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim tWs As Worksheet
  Dim nWs As Worksheet
  Dim nWsTf As Worksheet


  Set tWs = Worksheets("実行シート")

  r = 2
  While tWs.Cells(r, 1) <> ""

    oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & tWs.Cells(r, 1).Value
    newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & tWs.Cells(r, 2).Value


    Set oWb = Workbooks.Open(oldPath)  '既にWBをOpenでも動作する仕様を確認
    Set oWs = oWb.Worksheets(tWs.Cells(r, 2).Value)
    MsgBox "Doesnt work" & r '↑ここでインデックスエラー
    'new------------


    Set nWb = Workbooks.Add
    Set nWs = nWb.Worksheets("Sheet1")
    oWs.Copy After:=nWs

    Application.DisplayAlerts = False
    nWs.Delete
    Application.DisplayAlerts = True

    'new tf------------
    Set nWsTf = nWb.Worksheets(tWs.Cells(r, 2).Value)
    nWsTf.Cells.Font.Name = "MS Pゴシック"


    nWb.SaveAs (newPath)


    r = r + 1
  Wend



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

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

質問への追記・修正、ベストアンサー選択の依頼

  • stdio

    2019/02/27 09:56

    すみません、全体的に処理が重い印象を受けます。
    もう少し考えて質問して頂けると幸いです。

    キャンセル

  • SugiuraY

    2019/02/27 10:41

    申し訳ございません。。あまりvbaに明るくないため、どのようにすれば処理が軽くなるのかが速やかにはわからないため少し調べるお時間をください。
    コメントお寄せいただきありがとうございます。

    キャンセル

  • stdio

    2019/02/27 10:47

    まずどの辺で止まっているのかを教えて下さい。
    ここで止まる等のコメントを入力した方が、良いアドバイスをもらえますよ。
    全体的に処理に無駄が多いように見えるのが気になりますが、今回は良いとしましょう。

    キャンセル

回答 2

checkベストアンサー

+1

アクティブ前提の作りになっているからのような気がします。
ブックをオープンした時点で、そちらのブックがアクティブになっていないでしょうか?
具体的な修正点としては、
単純にCells(r, 1)とするのではなく、シート名を指定すべきです。Worksheets("hoge").Cells(r, 1)など。
Worksheets(Cells(r, 2).Value).Activateのところも、アクティブにするのではなく、シートオブジェクトを作成すべきです。
Set sh = Worksheets(Cells(r, 2).Value)
その後、そのオブジェクトを使って、セルの参照を行います。
sh.Cells(略)
こんな感じで全体的に明示的なコードに修正してみてどうなるかご確認ください。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2019/02/27 10:39

    コメントありがとうございます。
    明示したコードに修正したのですが、オブジェクトはプロパティをサポートしていません。とのエラーが出力されました。
    ちょっと
    nWs.Name = tWs.Cells(r, 2).Value
    の箇所がオブジェクト化したあとにシート名を変更しており、変更後のシート名を直接オブジェクトする方法が思いつかなかったため、
    oWs.Copy After:=nWs(tWs.Cells(r, 2).Value)
    の箇所が自信がないのですが、ここをまたワークブックやワークシートを改めて明示しなければならないのでしょうか。。

    キャンセル

  • 2019/02/27 10:39

    たびたび申し訳ございません。

    キャンセル

  • 2019/02/27 10:47

    これでいいような気がしますが(エラーは出なくなる)、仕様的に求めている動きになるかはご確認ください。
    oWs.Copy After:=nWs

    キャンセル

  • 2019/02/27 10:56

    有難うございます、オブジェクト作成後加えた変更(.name)は当然にプロパティとして保持され続けるのですね、、失礼しました。
    一方でループ1回目は成功し2回目のループの頭でインデックス範囲外のエラーが出力されたのですが、ループさせる場合、オブジェクトは初期化をしなければならないのでしょうか?
    vba オブジェクト 初期化等であまりそれらしいものが見当たらなかったためご相談させてください。
    重ねて失礼いたします。

    キャンセル

  • 2019/02/27 11:07

    While Cells(r, 1) <> ""
    ここのCellsが曖昧になってるからでしょうか。
    ここも明示的にシートを指定しないとダメですね。

    キャンセル

  • 2019/02/27 12:07

    明示的に指定いたしました。
    また、すでに重複しているブックがあれば開かないようにもしたりしたのですが、なぜかループしてくれません。再修正コードは上述の通りです。
    実際にループにさせずにrに直接次の値を代入しても動くのですが、、、

    キャンセル

  • 2019/02/27 12:16

    tWs.Cells(r, 1) <> ""を
    CStr(tWs.Cells(r, 1) .Value) <> ""
    に変えてみてはいかがでしょうか?

    キャンセル

  • 2019/02/27 13:09

    エラーが出てる箇所が2周目の以下ですよね。
    oWb.Worksheets(tWs.Cells(r, 2).Value)
    rは3のはず。
    つまり実行シートの3行目1列目(A3)にあるブック名の中に、3行目2列目(B3)に書かれているシートが存在しないということになります。
    実行シートの値と、ブックの中身を良く見比べてみてください。
    他に要因となるものは見当たりません(たぶん)

    キャンセル

  • 2019/02/27 13:19

    コメントありがとうございます。
    再度確認しましたが、ご指摘の箇所に意図したシート名が存在しております。
    もし可能性があるとしたらループのA2とA3が同じつまり、すでに開いている同じファイルが対象になっております。ただ、事前に動かしてみたところ、すでに開いているファイルがある場合でも動作するために、 問題としなかったのですが念のために
    IF tWs.Cells(r, 1)<>tWs.Cells(r,-1 1) Then
    にして
    もし対象のファイルを既に開いていれば
    Set oWb =Workbooks(oldPath)
    としましたが、それでも同じ有効範囲エラーが生じている状況です

    キャンセル

  • 2019/02/27 13:19

    stdio様
    コメントありがとうございます。ご指摘のコードに修正しても
    同じエラーが出力されることが確認されました。

    キャンセル

  • 2019/02/27 13:23

    同じファイル名であっても問題は起きないような気はしますが。
    試しにループ内の最後で、
    oWb.Close
    ってやったらどうでしょうか。

    キャンセル

  • 2019/02/27 14:28

    何件あるのかわかりませんが、いずれにしてもオープンしっぱなしってのはよろしくないので、パフォーマンスは落ちるかもしれませんが、クローズの処理は入れたほうがいいですね。

    キャンセル

  • 2019/02/27 17:30

    コメントありがとうございます。
    仰る通り、Closeを挟めば正しく動作させることができました。
    対象のブックやシートを明示的に示したはずでなのに不思議な挙動なのですが、
    解決に至ることができたことについて、本当に深く感謝いたします。
    ただ、原因(なぜ明示している以外のブックに対して動作しているのか)は頑張って追求します。

    キャンセル

-2

"Set oWb = Workbooks.Open(oldPath)  '既にWBをOpenでも動作する仕様を確認”の行の次に、5行のコード

msgbox("シート名:" & tWs.Cells(r, 2).Value)
Set sheets = oWb.worksheets
for i=1 to sheets.count
  msgbox(i & " : " & sheets[i].name)
next i

を追加して実行してみてください。

追加したコードはインデックスエラーが起きるコードで使おうとしているシート名を表示し、その後でoldPathのworkbookに含まれるworksheetの名前を順に表示するものです。(表示にmsgboxを使っていますので、何度もmsgboxが表示されます)
使おうとしているシート名のworksheetが、oWbに含まれていないからインデックスエラーが起きる訳ですから、その状況を確認するためにシート名とoWsが持っているシートの名前を確認するところから始めたら良いのではないかと思います。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2019/02/27 13:21

    確認方法を詳細にご教示いただきありがとうございます。
    msgbox(i & " : " & sheets[i].name)
    の箇所についてコンパイルエラーが生じているのですが
    vbaでi番目の要素数を指定する場合にはsheets[i]で問題なのでしょうか?
    恐れ入りますが、宜しくお願い申し上げます。

    キャンセル

  • 2019/02/27 13:25

    Set oWb = Workbooks.Open(oldPath) の行にブレークポイントを設定して、デバッガで各オブジェクトの内容を確認してみてください。
    ”sheets[i]”については調べます。

    キャンセル

  • 2019/02/27 13:27

    For Each i In oWb.Sheets: Debug.Print i.Name: Next i
    で動作させることができました。
    そこで判明したのですが、こちらで出力されるシート名はnWbのシートでした。オブジェクトの中身がなぜ書き換わってしまうのか、ちょっと調べてみます。
    コメントいただきありがとうございます。

    キャンセル

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

  • VBA

    2317questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。