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

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

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

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

ループ

ループとは、プログラミングにおいて、条件に合致している間、複数回繰り返し実行される箇所や、その制御構造を指します

Q&A

解決済

2回答

1483閲覧

他のEXCELファイルデータをループで取得する方法について

yokoazu

総合スコア9

VBA

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

ループ

ループとは、プログラミングにおいて、条件に合致している間、複数回繰り返し実行される箇所や、その制御構造を指します

0グッド

0クリップ

投稿2022/04/20 02:40

「Book①.xlsx」から「Book②.xlsm」にデータを取得する事はできたのですが、ループ処理がわかりません。

VBAの勉強を始めたばかりの初心者です。
「Book②.xlsm」に画像のとおり取り込みファイルパス等を記載しています。この情報をもとに「Book①.xlsx」から「Book②.xlsm」にデータを取得するというマクロを作成しました。
イメージ説明

以下、No1の行のみ実行するコードです。
No2以降も空白になるまで繰り返し実行するコードに修正したいのですが、調べて色々試しましたがわかりませんでした。どのようなコードを記載したらよいのでしょうか。

'「取り込むEXCELファイルのパス」と「取り込むEXCELファイルのデータが存在するシートNO」を引数に持つEXCEL関数を作成。 Public Function GetExcelData(ByVal FilePath As String, ByVal SheetNo As String) As Variant Dim wb As Workbook Dim ws As Worksheet 'ワークブックを開く Set wb = Workbooks.Open(FilePath) 'シートを取得 Set ws = wb.Worksheets(SheetNo) 'データ入力されている範囲を取得する GetExcelData = ws.UsedRange 'ワークブックを閉じる wb.Close 'メモリー開放 Set ws = Nothing Set wb = Nothing End Function '次に、先程のEXCELデータ取り込み関数を利用する関数を作成。(No.1のデータ取り込み)) Public Sub Macro1() Dim var As Variant Dim FilePath As String Dim InSheetNo As String Dim OutSheetNo As String Dim OutCell As String With ThisWorkbook.Sheets(1) FilePath = .Range("B2") InSheetNo = .Range("C2") OutSheetNo = .Range("D2") OutCell = .Range("E2") row = row + 1 End With '他のEXCELファイルデータを取り込む var = GetExcelData(FilePath, InSheetNo) Dim MaxRow As Long Dim MaxCol As Long '最大行数を取得する MaxRow = UBound(var, 1) '最大列数を取得する MaxCol = UBound(var, 2) '自ワークブックの1番目のシートのセルA1を基点に取り込んだデータを出力する ThisWorkbook.Sheets(OutSheetNo).Range(OutCell).Resize(MaxRow, MaxCol).Value = var End Sub

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

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

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

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

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

guest

回答2

0

こんな感じ?

ExcelVBA

1Option Explicit 2 3Sub Main() 4 Dim rngBody As Range 5 Dim r As Range 6 7 'リストのデータ範囲取得 8 Set rngBody = GetListBody(ThisWorkbook.Worksheets(1), "B2", 4) 9 10 '行毎に繰り返し 11 For Each r In rngBody.Rows 12 With WorksheetFunction 13 DataIn .Transpose(.Transpose(r)) 'データの転記(一次配列で渡す) 14 End With 15 Next 16End Sub 17 18'********************************** 19'一覧表のデータ範囲の取得関数 20'第1引数:対象シート 21'第2引数:左上セルアドレス 22'第3引数:表の列数 23'返り値:セル範囲 24'*********************************** 25Private Function GetListBody(ByRef ws As Worksheet, _ 26 ByVal a As String, _ 27 ByVal c As Long) As Range 28 Dim rngBottom As Range 29 With ws.Range(a) 30 Set GetListBody = Application.Range(.Cells, .End(xlDown)).Resize(, c) 31 End With 32End Function 33 34'*************************************************** 35'データの転記 36'第1引数:元ファイルパス、元シート名、先シート名、先セルアドレスを一次配列で指定 37'***************************************************** 38Private Sub DataIn(ByVal v As Variant) 39 Dim wbk As Workbook 40 Dim wsh As Worksheet 41 42 'ファイルの存在確認 43 If Len(Dir(v(1))) > 0 Then 44 Set wbk = Workbooks.Open(v(1)) 45 Else 46 MsgBox "指定のファイルがありません." 47 Exit Sub 48 End If 49 50 'シートの存在確認 51 On Error Resume Next 52 Set wsh = wbk.Worksheets(v(2)) 53 On Error GoTo 0 54 If wsh Is Nothing Then 55 MsgBox "指定のシートがありません。" 56 GoTo WayOut 57 End If 58 59 'データの転記 60 With wsh.UsedRange 61 ThisWorkbook.Worksheets(v(3)).Range(v(4)).Resize(.Rows.Count, .Columns.Count).Value = .Value 62 End With 63 64WayOut: 65 wbk.Close False 66End Sub 67

あ、

>.End(xlDown)

データが2つ以上ないと、おかしなことになりますね^^;
ちょっとセル範囲の指定を工夫してみてください。

投稿2022/04/20 06:25

編集2022/04/20 06:35
mattuwan

総合スコア2136

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

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

yokoazu

2022/04/21 05:37

ありがとうございます。セル範囲工夫して考えてみます。 初心者すぎて何時間も考えてしまうので、質問後すぐ教えていただきすごいなと思っています。 頂いた回答で勉強させていただこうと思います。
mattuwan

2022/04/21 05:45

慣れですよ。何十回、何百回でもたくさんコードをみて、たくさんコード書くといいと思います。 エクセルVBAの質問掲示板はここ以外にもいくつかあるので、 回答のコードをいっぱいみたり、質問に対して自分ならどう書くか考えてみたりして経験を補うとよいかと。 セル範囲で、一番下のデータのセルを探すときは、シートの一番下からEnd(xlup)で検索するのが、 常套手段となります。 VBAの解説サイトもいくつかあるので、探してみましょう。
yokoazu

2022/04/21 06:06

慣れなんですね。はじめたばかりでサッパリわからなくて。 実行したい内容が1つでもコードの書き方は色々あるんですね。質問へ回答するのも経験になるのかぁ・・・まだまだ先の話ですが、知識がついてきたら回答者として経験積みたいと思います。まずは回答のコードを色々見てみます。 そうなんですね。覚えておきます!他にもサイト見てみようとおもいます。 勉強のしかたまで親切にアドバイス頂き感謝いたします。 >セル範囲で、一番下のデータのセルを探すときは、シートの一番下からEnd(xlup)で検索するのが、 常套手段となります。
guest

0

ベストアンサー

Public Sub Macro1()のみ修正すればOKです。
以下のようにします。

VBA

1Public Sub Macro1() 2 Dim var As Variant 3 Dim FilePath As String 4 Dim InSheetNo As String 5 Dim OutSheetNo As String 6 Dim OutCell As String 7 Dim maxrow_A As Long 8 Dim wrow As Long 9 Dim sh As Worksheet 10 Set sh = ThisWorkbook.Sheets(1) 11 maxrow_A = sh.Cells(Rows.count, "A").End(xlUp).row 'A列の最大行取得 12 For wrow = 2 To maxrow_A 13 14 FilePath = sh.Cells(wrow, "B").Value 15 InSheetNo = sh.Cells(wrow, "C").Value 16 OutSheetNo = sh.Cells(wrow, "D").Value 17 OutCell = sh.Cells(wrow, "E").Value 18 19 20 '他のEXCELファイルデータを取り込む 21 var = GetExcelData(FilePath, InSheetNo) 22 23 Dim maxrow As Long 24 Dim MaxCol As Long 25 26 '最大行数を取得する 27 maxrow = UBound(var, 1) 28 29 '最大列数を取得する 30 MaxCol = UBound(var, 2) 31 32 '自ワークブックの1番目のシートのセルA1を基点に取り込んだデータを出力する 33 ThisWorkbook.Sheets(OutSheetNo).Range(OutCell).Resize(maxrow, MaxCol).Value = var 34 Next 35End Sub 36

投稿2022/04/20 03:16

tatsu99

総合スコア5424

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

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

yokoazu

2022/04/21 05:43

もとのコードを修正したかたちでとてもわかりやすかったです。ありがとうございます。 実行したところデータ取得は成功したのですがエラー400が表示されてしまいます。 何からなにまで申し訳ないのですが、このエラー解消はどのようにしたら良いのでしょうか。
tatsu99

2022/04/21 05:55

こちらでは、3行分(3ブック)の処理が正常に処理できたことを確認しています。 エラー400が発生するのは、どの行でしょうか?
yokoazu

2022/04/21 06:10

1行のみの場合でも、2行の場合でも3行の場合でもエラー400となってしまいます。 tatsuさんが正常に処理できたという事はコード以外の問題も考えられるのでしょうか。
yokoazu

2022/04/21 06:13

ちなみに全て処理は正常に完了しています。何行でも正しく取り込みされました。 ですが最後にエラー400と表示されます。
tatsu99

2022/04/21 06:19

すみません誤解を与えてしまいました。どの行かというのは、マクロのどの行かという意味です。 例として Public Function GetExcelData(ByVal FilePath As String, ByVal SheetNo As String) As Variantの Set ws = wb.Worksheets(SheetNo) の行でエラーが発生してます。・・・・・というような返信を期待していました。 >tatsuさんが正常に処理できたという事はコード以外の問題も考えられるのでしょうか。 その可能性もありますが、マクロを修正すれば回避できる可能性もあります。 いずれにしろ、まずは、どの行でエラーが発生しているのかを特定する必要があります。
yokoazu

2022/04/21 06:41

すみませんでした。どの行かはデバッグ実行で確認すればわかるのでしょうか。 デバッグで実行したところ10行目のシートを取得部分(以下コード)で実行時エラー1004が表示されました。 Set ws = wb.Worksheets(SheetNo) 初心者すぎてまたトンチンカンな事を言っていたら申し訳ありません・・・
tatsu99

2022/04/21 06:58

Set ws = wb.Worksheets(SheetNo) このシートがないことが考えられます。10行目のシート名が、仮に"AAA"とすると、 10行目のブック内に"AAA"のシートがあるはずですが、それがないことが原因です。 エラー発生時、上記の行のSheetNoにマウスをあてると、その内容が表示されます。 それでシート名を確認してください。
yokoazu

2022/04/22 01:17

返信遅く申し訳ございません。原因がわかりました。ご指摘頂いたとおりでした。 質問時に張り付けた「Book②.xlsm」の画像A列に何も記載していない行のところもNoを入れていた事が原因でした。(貼り付けた画像で言うと、4行目が空欄なのにA列に「3」と入力していた事がエラーの原因) 空欄行はA列(No)も空欄にしたところエラーが解消されました。マウスをあてるとその内容が表示される事も知らず色々と勉強になりました。こんなに早く的確に回答を頂ける事に驚いています。丁寧にご指導頂き大変感謝しております。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問