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

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

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

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

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

解決済

アプリケーション定義またはオブジェクト定義のエラー 範囲指定の間違い? ブック名の処理 重複を防ぐ

SnowMonkey
SnowMonkey

総合スコア0

VBA

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

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

1回答

1評価

0クリップ

114閲覧

投稿2019/01/27 15:26

編集2022/01/12 10:58

前提

フォルダ内に、複数のエクセルブック(被験者の人数分)があります。
それらのブックを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

Option Explicit '「data」フォルダにあるファイルを開いて、その内容をこのワークブックにまとめる Sub importData() Dim fso As FileSystemObject Set fso = New FileSystemObject Dim f As File For Each f In fso.GetFolder(ThisWorkbook.Path & "\data").Files 'dataフォルダにあるファイルを1つずつ開いて処理 With Workbooks.Open(f.Path) Dim bkName As String bkName = .Name Dim i As Long For i = 1 To Worksheets.Count ' 全シートを処理する With .Worksheets("Sheet" & i) '----------データの複写先のシートの最終行を取得-------------------- Dim wsResult As Worksheet Set wsResult = ThisWorkbook.Worksheets("Sheet" & i) 'データの複写先のシート Dim LastRow As Long LastRow = wsResult.Cells(Rows.Count, 3).End(xlUp).row 'データの複写先のシートの最終行 '------開いたシートの使用されている範囲を、複写先シートの最終行の次行にコピーする A列とB列は空欄にしておく------------ .UsedRange.Copy wsResult.Cells(LastRow + 1, 3) '------データを追加した範囲のA列にブック名を書き込む------------ ' wsResult.Cells(LastRow + 1, 1).Value = bkName 'エラーは出ないが、空白セルができる Dim LastRow2 As Long LastRow2 = wsResult.Cells(Rows.Count, 2).End(xlUp).row 'データの複写先のシートの最終行を再び取得して wsResult.Range(Cells(LastRow + 1, 1), Cells(LastRow2, 1)).Value = bkName End With Next i .Close End With Next f End Sub

試したこと

1つのセルに記入できることを確認
→Rangeの使い方に問題がありそうということで、
ネットに記載されていたものをコピペしてみたが、
それでも上手くいかない。

補足情報(FW/ツールのバージョンなど)

Excel 2016

良い質問の評価を上げる

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

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

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

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

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

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

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

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

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

hatena19
hatena19

2019/01/28 04:15

エラーがでるコードがどれか明確にしてください。

まだ回答がついていません

会員登録して回答してみよう

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

ただいまの回答率
87.20%

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

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

質問する

関連した質問

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

VBA

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

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。