前提
フォルダ内に、複数のエクセルブック(被験者の人数分)があります。
それらのブックを1つのブックにまとめるコードを書きました。
例えば、
フォルダ内全ブックのSheet1を、複写先のSheet1に
フォルダ内全ブックのSheet2を、複写先のSheet2に まとめるものです
色々調べて
まとめること自体は一応できました。
ブック名に関する処理を追加しようとしたときに、皆様の
お知恵を拝借できればありがたいと思いました。
######ブック名
フォルダ内のブック名には、
- 実験条件(たとえば測定したのが室内か野外か)と、
- 2桁の被験者ID番号
の情報が含まれています
野外で測定した被験者12番のブックなら、
yagai12.xls とつけます。
実現したいこと・助言を欲しいこと
1.ブック名を切り分けて、A列とB列に記入する
yagai12.xls というブック名なら
yagaiと12を切り分けて、yagaiをA列に、12をB列の該当行に空白なく記入する
2.同じファイルを何度も処理しないようにする
これもブック名を使ってチェックすればいいのかなと思いますが、具体策が思いつかない。
3.ブック名に関する処理以外も含めて、もっと良い書き方があれば助言を得たい。
発生している問題・エラーメッセージ
1.や2.の処理をする前段階として、ブック名を取得して、A列を埋めようとしたときに
上手くいきませんでした。
コードを実行すると以下のエラーメッセージが表示されます。
アプリケーション定義またはオブジェクト定義のエラーです
該当のソースコード
VBA
1Option Explicit 2 3'「data」フォルダにあるファイルを開いて、その内容をこのワークブックにまとめる 4Sub importData() 5Dim fso As FileSystemObject 6Set fso = New FileSystemObject 7 8 9Dim f As File 10For Each f In fso.GetFolder(ThisWorkbook.Path & "\data").Files 'dataフォルダにあるファイルを1つずつ開いて処理 11 With Workbooks.Open(f.Path) 12 Dim bkName As String 13 bkName = .Name 14 15 Dim i As Long 16 For i = 1 To Worksheets.Count ' 全シートを処理する 17 With .Worksheets("Sheet" & i) 18 19 '----------データの複写先のシートの最終行を取得-------------------- 20 Dim wsResult As Worksheet 21 Set wsResult = ThisWorkbook.Worksheets("Sheet" & i) 'データの複写先のシート 22 23 Dim LastRow As Long 24 LastRow = wsResult.Cells(Rows.Count, 3).End(xlUp).row 'データの複写先のシートの最終行 25 26 '------開いたシートの使用されている範囲を、複写先シートの最終行の次行にコピーする A列とB列は空欄にしておく------------ 27 .UsedRange.Copy wsResult.Cells(LastRow + 1, 3) 28 29 '------データを追加した範囲のA列にブック名を書き込む------------ 30' wsResult.Cells(LastRow + 1, 1).Value = bkName 'エラーは出ないが、空白セルができる 31 Dim LastRow2 As Long 32 LastRow2 = wsResult.Cells(Rows.Count, 2).End(xlUp).row 'データの複写先のシートの最終行を再び取得して 33 wsResult.Range(Cells(LastRow + 1, 1), Cells(LastRow2, 1)).Value = bkName 34 35 End With 36 Next i 37 .Close 38 39 End With 40 41Next f 42 43End Sub 44 45
上記のうち、この部分だと思います。ここを外すとエラーメッセージは出ません。
VBA
1 2 '------データを追加した範囲のA列にブック名を書き込む------------ 3' wsResult.Cells(LastRow + 1, 1).Value = bkName 'エラーは出ないが、空白セルができる 4 Dim LastRow2 As Long 5 LastRow2 = wsResult.Cells(Rows.Count, 2).End(xlUp).row 'データの複写先のシートの最終行を再び取得して 6 wsResult.Range(Cells(LastRow + 1, 1), Cells(LastRow2, 1)).Value = bkName 7
試したこと
1つのセルに記入できることを確認
→Rangeの使い方に問題がありそうということで、
ネットに記載されていたものをコピペしてみたが、
それでも上手くいかない。
補足情報(FW/ツールのバージョンなど)
Excel 2016
回答1件
あなたの回答
tips
プレビュー