初心者ですエクセルマクロでデータ抽出したいですがファイルによって読込できません、何か問題ありますか?ちなみにファイル名は読み込めますが、データ読み込みでエラーになるようです。
実行時エラー'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で質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) VBAが止まります。 2 2022/09/02 14:02
- Visual Basic(VBA) 2つ目のコンボボックスが動作しません。 3 2023/03/25 12:29
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) 他のシートからコピーする下記マクロで貼付け位置をWorksheets(1).Range("A3")の 8 2023/01/30 18:48
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBから参照できないCのDLLを使...
-
access テキストボックスの値取得
-
Returnに対するGoSubがありません
-
VBでファイルが開かれているか...
-
batファイルでレジストリキーの...
-
ExcelVBAで既に開いてるwordを...
-
アクセスのクエリでコンパイル...
-
すでにファイルが開かれている...
-
EXCELのVBAでWORDが開いてある...
-
ファイルクローズ(fclose)でエ...
-
Excelvbaのマクロのファイル名...
-
OUTLOOK VBA 指定フォルダ内の...
-
FTPの送信結果を検知したい
-
Excelのエラー
-
Request.BinaryReadでのエラー
-
Access2010 コンパイルエラー...
-
freadでデータがない場合の読込...
-
[VBS]ファイルコピーで怪奇現象
-
gccを行ってもexeファイルが生...
-
DBへのコネクションタイムアウト
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
batファイルでレジストリキーの...
-
FTPの送信結果を検知したい
-
「パス名が無効です」の発生原因
-
VBでファイルが開かれているか...
-
アクセスのクエリでコンパイル...
-
NAS上のファイルの使用中が解除...
-
Returnに対するGoSubがありません
-
PowerShellを使って関連付けら...
-
access テキストボックスの値取得
-
VBから参照できないCのDLLを使...
-
VB6 Dir関数で52エラー発生
-
freadでデータがない場合の読込...
-
すでにファイルが開かれている...
-
ACCESS VBAでのインポート
-
Access2013にてドラッグ&ドロ...
-
エクセルマクロでエラーの原因...
-
DisplayAlertsブロパティで ”実...
-
OUTLOOK VBA 指定フォルダ内の...
-
FORTRANの実行エラーについて
-
EXCELのVBAでWORDが開いてある...
おすすめ情報