- ベストアンサー
エクセル 複数ファイルから特定のデータを一覧に
- エクセルを使用して、複数のファイルから特定のデータを一覧にまとめる方法についての質問です。
- 参照用ファイルに指定した値と一致するデータのみを抽出して、一覧に表示したいと考えています。
- 関数またはVBAを使って処理する方法があるか教えていただけないでしょうか？
- namsan3
- お礼率60% (42/69)
- その他MS Office製品
- 回答数3
- ありがとう数5
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (2)
- merlionXX
- ベストアンサー率48% (1930/4007)
> ここで重ねて質問させて頂きます。 わかりました。では前回の質問は締め切ってください。 > 参照するE:G列の年月（oooo/oo）は実は他の入力した数値から関数で 出している数字なのですが、参照先が関数式の場合、A1セルと合致している 年月としてみなされないのでしょうか？ そんなことはないです。 直接入力している列を参照させてうまくいったのならコードは正しいと思います。しかし関数表示の方がマッチしないなら関数で表示されたデータを確認してみてください。 関数でoooo/oo と表示さたセルを他のセルで参照してみて、そのセル書式をyyyy/m/d h:mmにしたらどう出ますか？ A1セルの書式も同じyyyy/m/d h:mm にして比べてください。 yyyy/mmだけの表示だと日が違って同じに見えるので厄介です。 もし、日付か時間が違うのなら、年と月だけで検索するようにコードを変更します。 あと、関数式だと前回のTEST02では正しくコピーされないので、これも変更しなくてはいけません。 それから、名前が"一覧"か"作業用シート"でないシートだけを対象にすればよいのですね？ Sub test03() Dim wb(1) As Workbook Dim ws(2) As Worksheet Dim myFl As String, MyPt As String Dim myTg Dim i As Long Dim myC As Range Set wb(0) = ThisWorkbook Set ws(0) = wb(0).Sheets("Sheet1") Set ws(1) = Sheets.Add(after:=Sheets(wb(0).Sheets.Count)) MyPt = wb(0).Path & "\" myFl = Dir(MyPt & "*.xls", vbNormal) Application.ScreenUpdating = False myTg = ws(0).Range("A1").Value Do While myFl <> "" If myFl <> wb(0).Name Then Set wb(1) = Workbooks.Open(MyPt & myFl) For Each ws(2) In wb(1).Worksheets With ws(2) If .Name <> "一覧" And .Name <> "作業用シート" Then '名前が"一覧"か"作業用シート"でなきゃ If .UsedRange.Cells(.UsedRange.Count).Column > 4 Then For Each myC In Intersect(.Range("E:G"), .UsedRange) ' If IsDate(myC.Value) Then '日付データなら If Format(myC.Value, "yyyy/mm") = Format(myTg, "yyyy/mm") Then i = i + 1 myC.EntireRow.Copy ws(1).Rows(i).PasteSpecial ws(1).Rows(i).PasteSpecial Paste:=xlPasteValues '値貼り付けに Application.CutCopyMode = False End If End If Next myC End If End If End With Next ws(2) wb(1).Close (False) End If myFl = Dir() Loop '繰り返し Application.ScreenUpdating = True End Sub
お礼
早速のお返事本当にありがとうございました。 上記式にて問題なく実行できました。 大変助かりました。 厚かましくて恐縮なのですが、 最後にもうひとつだけお願いをさせて頂ければ幸いです。 始めに言うべきだったのですが、 最終的に引っ張ってきたデータをもとに関数処理させたい 部分があります。 新たなシートを作成せずに、 "sheet2"の"3"行目以降に、元のデータの"A～Z列"をコピペしろ という形にするには上記式の変更で済みますでしょうか？
- merlionXX
- ベストアンサー率48% (1930/4007)
おや、今朝お書きになった「実行するとオブジェクトが必要ですと出てしまい、」という補足へ、さきほど再度回答したのですが、別に再質問されていたのですか・・・・。 (゜〇゜;) ちょうどよい？機会ですので少しご説明します。 30ファイルの全シートに対して検索をかけたのですが、各シートの対象列の全行を見るのも非効率ですから、Ｂ～Ｄ列かつ使用範囲という限定をかけました。 ところが、多分、シートの中にはＢ列以降（実際は違うのでしたね）をまったく使用していないシートがあったのだと思います。そのためのエラーです。 ファイル1（4シート+一覧シート） ファイル2（4シート+一覧シート） ファイル3（4シート+一覧シート） ファイル4（4シート+一覧シート） ファイル5（4シート+一覧シート） とお書きなので、そのうちの一覧シートというのがそうではないかと推測しますが、ご提供の情報だけでは他のシートとＢ列以降を使ってないシートを区別できないのです。 （たとえば一覧シートはかならずシート名の最後が「一覧」であり他のデータシートと区別できるとか、規則性があれば最初からそのシートは除いて検索できますが。） そのような情報がないので、先ほどの質問への再回答は、その指定列以降にデータがないシートを除外するようにしてあります。 お試しください。
お礼
たびたびのご回答誠にありがとうございました。 上記VBAにて試させて頂いたところ、データがうまく表示されないので、 （新しいシートはできるが白紙のまま） 参照範囲などをいじっていたところ、もしやと思うことがあったので、 大変恐縮ですが、ここで重ねて質問させて頂きます。 ■参照するE:G列の年月（oooo/oo）は実は他の入力した数値から関数で 出している数字なのですが、参照先が関数式の場合、A1セルと合致している 年月としてみなされないのでしょうか？ ※直接入力している列を上記マクロにて参照させてみたところうまくいったので・・。 ■ ＞たとえば一覧シートはかならずシート名の最後が「一覧」であり他のデータシートと区別できるとか、規則性があれば最初からそのシートは除いて検索できますが。 こちらで仰って頂いたことに甘えての質問ですが・・・、 全てのファイルに必ず“一覧”及び“作業用シート”というものが存在しています。 これらを検索対象から外すにはどのような式を書いてやればいいのでしょうか？ お手数をかけて申し訳ないのですが、宜しくお願い致します。
補足
Sub test02() Dim wb(1) As Workbook '変数宣言 Dim ws(2) As Worksheet Dim myFl As String, MyPt As String Dim myTg Dim i As Long Dim myC As Range Set wb(0) = ThisWorkbook Set ws(0) = wb(0).Sheets("Sheet1") Set ws(1) = Sheets.Add(after:=Sheets(wb(0).Sheets.Count)) 'シート追加 MyPt = wb(0).Path & "\" '自分のパスを取得 myFl = Dir(MyPt & "*.xls", vbNormal) 'パス内のエクセルファイル Application.ScreenUpdating = False '画面更新停止 myTg = ws(0).Range("A1").Value '検索年月 Do While myFl <> "" 'エクセルBOOKがなくなるまで If myFl <> wb(0).Name Then '自分以外のファイルを対象 Set wb(1) = Workbooks.Open(MyPt & myFl) '選択したBOOKを開く For Each ws(2) In wb(1).Worksheets '開いたBOOKの各シート With ws(2) If .UsedRange.Cells(.UsedRange.Count).Column > 4 Then 'E列以降にデータがあれば For Each myC In Intersect(.Range("E:G"), .UsedRange) 'E:G列 If myC.Value = myTg Then '検索年月があったら i = i + 1 'カウント myC.EntireRow.Copy ws(1).Rows(i) 'その行を追加したシートにコピペ End If Next myC End If End With Next ws(2) wb(1).Close (False) '選択したファイルを閉じる End If myFl = Dir() '次のファイルを検索 Loop '繰り返し Application.ScreenUpdating = True '画面更新停止解除 End Sub
お礼
本当にありがとうございました。 上記ＶＢＡにてやりたいことが全て実行されました。 長々とお付き合い頂き誠にありがとうございます。 ＞原因は何だったのか、日付が違っていた、時間が入っていた等、具体的に書いていただけると、ありがたいのですが。 尚、こちらに関しまして、実は原因がよく分かりませんでした。 元ファイル及び、検索用ファイルの年月欄の書式を変えてみて 検証したのですが、合致したものだったので。。 ＞その際、Sheet2"の"3"行目以降にデータがあっても上書きしてかまわないのですか？ こちらに関しては、確かに仰るように分かりづらくなってしまうので、 勝手に作成頂いたＶＢＡに３行目以降をまず消す処理を加えさせて頂きました。 稼動は問題ないので、多分大丈夫かと思います。 また、VBAは初心者なのですが、丁寧に書いて頂いたことで 非常に勉強になりました。 重ねて御礼申し上げます。