初心者ですエクセルマクロでデータ抽出したいですがファイルによって読込できません、何か問題ありますか?ちなみにファイル名は読み込めますが、データ読み込みでエラーになるようです。
実行時エラー'9'
インデックスが有効範囲にありません。
Sub ExcelbookCombine()
'-------------------------------------------------------------------------------------------------------
'処理開始
'-------------------------------------------------------------------------------------------------------
MsgBox MESSAGE_START
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then Exit Sub
Fol = .SelectedItems(1)
End With
Dim Fn
' Dim NewFile As Workbook
Dim Wb As Workbook
'Dim Ws1 As Worksheet
Dim R As Range
Dim SrcRng As Range
Dim Rng As Range
'開始行の指定(データ最終行の次の行
Dim n
n = Cells(Rows.Count, 1).End(xlUp).Row + 1
'セットするシートの指定
Dim w
Set w = Worksheets(1)
'ファイル名(拡張子なし)を取得するためのFileSystemObjectオブジェクト - GetBaseNameメソッド
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SrcRng = ActiveSheet.Range("B4")
Set Ws1 = Worksheets(1)
Set R = Ws1.Range("A2")
Fn = Dir(Fol & "\*.xls*")
Do Until Fn = ""
Set Wb = Workbooks.Open(Fol & "\" & Fn)
'ワークシート1をコピーする場合は Wb.Worksheets(1)
'Set Ws2 = Wb.Worksheets(3)
'
''
'各所の値をコピーしてa~gにセットする
' ActiveSheet.Unprotect
w.Range("a" & n).Value = FSO.getbasename(Fn)
'この下の行がエラー時に反転します
w.Range("c" & n).Value = Workbooks(Fn).Worksheets(3).Range("b3").Value
w.Range("d" & n).Value = Workbooks(Fn).Worksheets(3).Range("o6").Value
w.Range("e" & n).Value = Workbooks(Fn).Worksheets(2).Range("aa3").Value
w.Range("f" & n).Value = Workbooks(Fn).Worksheets("指定額").Range("cj3").Value
w.Range("g" & n).Value = Workbooks(Fn).Worksheets("指定額").Range("b5").Value
w.Range("h" & n).Value = Workbooks(Fn).Worksheets("指定額").Range("o5").Value
w.Range("i" & n).Value = Workbooks(Fn).Worksheets("指定額").Range("b7").Value
w.Range("j" & n).Value = Workbooks(Fn).Worksheets("指定額").Range("cj55").Value
w.Range("a" & n).Resize(1, 10).Borders.LineStyle = xlContinuous
n = n + 1
Workbooks(Fn).Close savechanges:=False
Fn = Dir
Loop
Range("A4").Select
MsgBox MESSAGE_FINISH
Set R = Nothing
Set Ws1 = Nothing: Set Ws2 = Nothing
Set Wb = Nothing: Set NewFile = Nothing
End Sub
No.1ベストアンサー
- 回答日時:
こんにちは。
最初に、朝から、この質問は、何度か消えていませんか。
そのたびに内容は変わっていないといいのですが。
お急ぎなのは分かりますが、なかなか、すぐに返事出来ない時があります。
ざっと見た感じですが、コードはひどく雑ですが、特に問題になる部分はありません。
ただ、
Set Wb = Workbooks.Open(Fol & "\" & Fn)
となっているのですから、
Wb.Worksheets(3).Range("b3").Value
となりますね。
実行時エラー'9'
インデックスが有効範囲にありません
ということは、
Wb.Worksheets(3)
Wb.Worksheets(2)
Wb.Worksheets("指定額")
この3つの内、ないものがあるということです。シートの数なのか、「指定額」というシートかは分かりません。
以下のコードで書き加えた所をみてください。
また、
If num > 3 And TypeName(dummy) = "Worksheet" Then
これは多少工夫してください。
だから、フォルダーの中を全部のファイルをあたり、データを吸い上げるようにするには、以下のようにします。
'---中略----
'各所の値をコピーしてa~gにセットする
' ActiveSheet.Unprotect
Dim dummy As Variant '←Variant型で指定
Dim num As Long
On Error Resume Next '←エラートラップ
num = Wb.Worksheets.Count
Set dummy = Wb.Worksheets("指定額")
If num > 3 And TypeName(dummy) = "Worksheet" Then 'シートの数と指定額のシートがあるか?
With Wb
w.Range("a" & n).Value = FSO.getbasename(Fn)
w.Range("c" & n).Value = .Worksheets(3).Range("b3").Value
w.Range("d" & n).Value = .Worksheets(3).Range("o6").Value
w.Range("e" & n).Value = .Worksheets(2).Range("aa3").Value
w.Range("f" & n).Value = .Worksheets("指定額").Range("cj3").Value
w.Range("g" & n).Value = .Worksheets("指定額").Range("b5").Value
w.Range("h" & n).Value = .Worksheets("指定額").Range("o5").Value
w.Range("i" & n).Value = .Worksheets("指定額").Range("b7").Value
w.Range("j" & n).Value = .Worksheets("指定額").Range("cj55").Value
w.Range("a" & n).Resize(1, 10).Borders.LineStyle = xlContinuous
n = n + 1
.Close savechanges:=False
End With
Set dummy = Nothing
Else
Debug.Print Wb.Name 'ファイルの名前を残す(必要がなければこの行なし)
Wb.Close False
End If
Fn = Dir
Loop
というようにしたらどうでしょう。
ありがとうございます!!
きっとできたと思います!
とりあえず読み込めたので
後でじっくり分析してみます!
急いでたので中身は変えずに更新していましたwすいません。。。
No.2
- 回答日時:
返事ありがとうございます。
簡略化してみると分かるかと思います。
Do Until Fn = ""
ファイルを取得
①
Wb.Worksheets(3)
Wb.Worksheets(2)
Wb.Worksheets("指定額")
この条件を満たしているか。エラーの発生をチェックして、
②
エラートラップ(On Error ....)で捕まえて、
-エラーがないなら、中身を読む
-エラーが発生したら、中身を読まないようにする。
③
Fn = Dir
次のファイルを探す。
-Loop
という仕組みです。
そうですよね、初心者なので最短でやりたいことのみで構成しているので
こんなトラップとか神レベルです。
w.Range("d" & n).Value = .Worksheets(3).Range("o6").Value
w.Range("e" & n).Value = .Worksheets(2).Range("aa3").Value
w.Range("f" & n).Value = .Worksheets("指定額").Range("cj3").Value
というのはエラーが出るのでシートの指定を色々と変えてみたので、こうなっていますw
でも、結局のところ、ご指摘のとおり
ただ、
Set Wb = Workbooks.Open(Fol & "\" & Fn)
となっているのですから、
Wb.Worksheets(3).Range("b3").Value
となりますね。
という部分が問題になっていただけな気がしました。
色々とかえて検証して勉強したいと思います。
本当にありがとうございました!助かります。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
「パス名が無効です」の発生原因
-
OUTLOOK VBA 指定フォルダ内の...
-
「アクティブ ユーザーが多すぎ...
-
CSVファイルが開かれているかど...
-
Returnに対するGoSubがありません
-
batファイルでレジストリキーの...
-
EXCELVBAでONEDRIVE上への保管...
-
ExcelVBAで既に開いてるwordを...
-
C++Builderについて
-
VB6 Dir関数で52エラー発生
-
RAR圧縮ファイル(分割)の順番が...
-
システムのシャットダウンは既...
-
この文書を開くときにエラーが...
-
エクセル VBA dll 読み込...
-
FTPの送信結果を検知したい
-
4.0マクロを Excel2003で実行?
-
メニューのショートカットキー
-
VB スクリプトで
-
VBから参照できないCのDLLを使...
-
Adobeのプレミアプロの書き出し...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Vba ファイル書き込み時に書き...
-
「パス名が無効です」の発生原因
-
Returnに対するGoSubがありません
-
PowerShellを使って関連付けら...
-
エクセル VBA dll 読み込...
-
batファイルでレジストリキーの...
-
gccを行ってもexeファイルが生...
-
アクセスのクエリでコンパイル...
-
VBから参照できないCのDLLを使...
-
access テキストボックスの値取得
-
VBでファイルが開かれているか...
-
EXCELのVBAでWORDが開いてある...
-
NAS上のファイルの使用中が解除...
-
VB6 Dir関数で52エラー発生
-
VBA ExecuteExcel4Macro 型が一...
-
エクセルマクロでエラーの原因...
-
fgets関数のEOFの扱い方について
-
【COBOL】read文でエラー
-
FTPの送信結果を検知したい
-
FORTRANの実行エラーについて
おすすめ情報