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

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

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

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

Q&A

解決済

2回答

7786閲覧

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

SugiuraY

総合スコア317

VBA

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

0グッド

0クリップ

投稿2019/02/27 00:40

編集2019/02/27 03:08

現在ブックが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の同じシート名の晴れという内容を
コピーしてきたい

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

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

vba

1 2Sub fileOpenAndCreate() 3 Dim fileName As String 4 Dim r As Long 5 Dim wb As Workbook 6 Dim oldPath As String 7 Dim newPath As String 8 9 r = 2 10 While Cells(r, 1) <> "" 11 oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & Cells(r, 1).Value 12 newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & Cells(r, 2).Value 13 14 Workbooks.Open (oldPath) '既にWBをOpenでも動作する仕様を確認 15 Worksheets(Cells(r, 2).Value).Activate 16 Set wb = Workbooks.Add 17 wb.SaveAs (newPath) 18 Worksheets(1).Name = Cells(r, 2).Value 19 20 Workbooks(oldPath).Worksheets(Cells(r, 1).Value).Copy After:=Workbooks(newPath).Worksheets(Cells(r, 1).Value) 21 22 23 r = r + 1 24 Wend 25 26 27 28End Sub

修正後のコード

vba

1Sub fileOpenAndCreate() 2 Dim fileName As String 3 Dim r As Long 4 Dim oldPath As String 5 Dim newPath As String 6 7 Dim nWb As Workbook 8 Dim oWb As Workbook 9 Dim oWs As Worksheet 10 Dim tWs As Worksheet 11 Dim nWs As Worksheet 12 13 14 Set tWs = Worksheets("実行シート") 15 16 r = 2 17 While Cells(r, 1) <> "" 18 oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & tWs.Cells(r, 1).Value 19 newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & tWs.Cells(r, 2).Value 20 21 'old------------ 22 Set oWb = Workbooks.Open(oldPath) '既にWBをOpenでも動作する仕様を確認 23 Set oWs = oWb.Worksheets(tWs.Cells(r, 2).Value) 24 25 'new------------ 26 Set nWb = Workbooks.Add 27 nWb.SaveAs (newPath) 28 Set nWs = nWb.Worksheets(1) 29 nWs.Name = tWs.Cells(r, 2).Value 30 31 32 oWs.Copy After:=nWs(tWs.Cells(r, 2).Value) 33 34 35 r = r + 1 36 Wend 37 38 39 40End Sub

再修正コード

vba

1Sub fileOpenAndCreate() 2 Dim fileName As String 3 Dim r As Long 4 Dim oldPath As String 5 Dim newPath As String 6 7 Dim nWb As Workbook 8 Dim oWb As Workbook 9 Dim oWs As Worksheet 10 Dim tWs As Worksheet 11 Dim nWs As Worksheet 12 Dim nWsTf As Worksheet 13 14 15 Set tWs = Worksheets("実行シート") 16 17 r = 2 18 While tWs.Cells(r, 1) <> "" 19 20 oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & tWs.Cells(r, 1).Value 21 newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & tWs.Cells(r, 2).Value 22 23 24 Set oWb = Workbooks.Open(oldPath) '既にWBをOpenでも動作する仕様を確認 25 Set oWs = oWb.Worksheets(tWs.Cells(r, 2).Value) 26 MsgBox "Doesnt work" & r '↑ここでインデックスエラー 27 'new------------ 28 29 30 Set nWb = Workbooks.Add 31 Set nWs = nWb.Worksheets("Sheet1") 32 oWs.Copy After:=nWs 33 34 Application.DisplayAlerts = False 35 nWs.Delete 36 Application.DisplayAlerts = True 37 38 'new tf------------ 39 Set nWsTf = nWb.Worksheets(tWs.Cells(r, 2).Value) 40 nWsTf.Cells.Font.Name = "MS Pゴシック" 41 42 43 nWb.SaveAs (newPath) 44 45 46 r = r + 1 47 Wend 48 49 50 51End Sub 52 53 54

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

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

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

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

stdio

2019/02/27 00:56

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

2019/02/27 01:41

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

2019/02/27 01:47

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

回答2

0

ベストアンサー

アクティブ前提の作りになっているからのような気がします。
ブックをオープンした時点で、そちらのブックがアクティブになっていないでしょうか?
具体的な修正点としては、
単純に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 00:51

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

SugiuraY

2019/02/27 01:39

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

2019/02/27 01:39

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

2019/02/27 01:47

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

2019/02/27 01:56

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

2019/02/27 02:07

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

2019/02/27 03:07

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

2019/02/27 03:16

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

2019/02/27 04:09

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

2019/02/27 04:19

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

2019/02/27 04:19

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

2019/02/27 04:23

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

2019/02/27 05:28

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

2019/02/27 08:30

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

0

"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 03:44

coco_bauer

総合スコア6915

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

SugiuraY

2019/02/27 04:21

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

2019/02/27 04:25

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

2019/02/27 04:27

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問