Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6913 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【42373】複数ファイルから一つのファイルに一覧表... やふーー 06/9/8(金) 17:13 質問[未読]
【42377】Re:複数ファイルから一つのファイルに一覧... ponpon 06/9/8(金) 21:13 発言[未読]
【42378】追加 やふーー 06/9/8(金) 21:18 質問[未読]
【42379】Re:複数ファイルから一つのファイルに一覧... かみちゃん 06/9/8(金) 21:37 発言[未読]
【42382】Re:複数ファイルから一つのファイルに一覧... やふーー 06/9/8(金) 23:14 質問[未読]
【42383】Re:複数ファイルから一つのファイルに一覧... かみちゃん 06/9/8(金) 23:47 回答[未読]
【42384】Re:複数ファイルから一つのファイルに一覧... ponpon 06/9/9(土) 0:15 発言[未読]
【42420】Re:複数ファイルから一つのファイルに一覧... やふーー 06/9/11(月) 9:15 お礼[未読]
【42427】Re:複数ファイルから一つのファイルに一覧... やふーー 06/9/11(月) 17:04 質問[未読]
【42430】Re:複数ファイルから一つのファイルに一... ponpon 06/9/11(月) 22:58 発言[未読]
【42440】Re:複数ファイルから一つのファイルに一... やふーー 06/9/12(火) 9:38 質問[未読]
【42441】Re:複数ファイルから一つのファイルに一... ponpon 06/9/12(火) 10:36 発言[未読]
【42444】Re:複数ファイルから一つのファイルに一... やふーー 06/9/12(火) 10:56 質問[未読]
【42448】Re:複数ファイルから一つのファイルに一... ponpon 06/9/12(火) 13:15 発言[未読]
【42456】Re:複数ファイルから一つのファイルに一... やふーー 06/9/12(火) 15:58 質問[未読]
【42457】Re:複数ファイルから一つのファイルに　ヘ... ponpon 06/9/12(火) 16:32 発言[未読]
【42468】Re:複数ファイルから一つのファイルに　ヘ... やふーー 06/9/12(火) 21:45 質問[未読]
【42470】Re:複数ファイルから一つのファイルに　ヘ... ponpon 06/9/12(火) 23:30 発言[未読]
【42491】Re:複数ファイルから一つのファイルに　ヘ... やふーー 06/9/13(水) 11:38 お礼[未読]
【42373】複数ファイルから一つのファイルに一覧表...
質問  やふーー  - 06/9/8(金) 17:13 -
引用なし
パスワード
   エクセルで、特定のフォルダ内にある複数のエクセルファイルから、
一覧表を全て抽出し、集計用のエクセルシートにズラズラっと
並べるにはどのようにすれば良いのでしょうか？

条件としては、特定フォルダ内に

AAA(15年).xls
AAA(14年).xls　
AAA(13年).xls　
AAA(12年).xls

というように、抽出したいファイルには先頭に「AAA」と名前が
付けてあります。

また、それぞれのファイルは全て同じ構成で、３つのシートがあり、
そのうちの「一覧表」シートの内容を全て抽出したいと考えています。

そして、集計用のファイル「年度集計.xls」に全てのファイルの
一覧表を、一つのシートに抽出したいのです。

よろしくお願いします。　　
【42377】Re:複数ファイルから一つのファイルに一...
発言  ponpon  - 06/9/8(金) 21:13 -
引用なし
パスワード
   こんばんは。

Dirで検索すると、たくさんヒットすると思います。
【42378】追加
質問  やふーー  - 06/9/8(金) 21:18 -
引用なし
パスワード
   条件として、特定のフォルダに入っているファイルの数は
いくつと決まっていないので、「フォルダの中に入っている
AAA*.xls　全てを対象として、一覧表のデータを抽出し
コピーする」という形です。すいません。
【42379】Re:複数ファイルから一つのファイルに一...
発言  かみちゃん  - 06/9/8(金) 21:37 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>そのうちの「一覧表」シートの内容を全て抽出したいと考えています。
>
>そして、集計用のファイル「年度集計.xls」に全てのファイルの
>一覧表を、一つのシートに抽出したい

「年度集計.xls」のどのシートに、特定フォルダ内にあるAAAで始まるExcelブック
すべての「一覧表」シートの内容をどのように抽出したいのでしょうか？

・「年度集計.xls」のまとめたいシート名
・そのシートのシートイメージ
・「一覧表」シートのシートイメージ
の説明がないとアドバイスは、難しいです。

シートイメージは、以下のようなもので示していただきたいです。
　　 A　　　　　B　　　　　C
1
2
3
4
【42382】Re:複数ファイルから一つのファイルに一...
質問  やふーー  - 06/9/8(金) 23:14 -
引用なし
パスワード
   かみちゃんさんこんにちは。

>「年度集計.xls」のどのシートに、特定フォルダ内にあるAAAで始まる
>Excelブックすべての「一覧表」シートの内容をどのように抽出したいのでしょうか？

えーっと、「一覧表」シートの内容はそのまま全て抽出（というか
丸写し）したいと思ってます。

AAA(15年).xlsの「一覧表」シートの内容

　　　A　　　　B　　　C
１　あああ　　男　　神奈川
２　いいい　　女　　東京
３　ううう　　女　　千葉

AAA(14年).xlsの「一覧表」シートの内容

　　　A　　　　B　　　C
１　ｑｑｑ　　男　　埼玉
２　ｐｐｐ　　男　　群馬
３　ｋｋｋ　　女　　長野


これを「年度集計.xls」の「全件一覧」シートに
繋げてコピーしたいのです。

　　　A　　　　B　　　C
１　あああ　　男　　神奈川
２　いいい　　女　　東京
３　ううう　　女　　千葉
４　ｑｑｑ　　男　　埼玉
５　ｐｐｐ　　男　　群馬
６　ｋｋｋ　　女　　長野

このような感じです。

集めたいファイルの数が処理のたびに増えたり減ったり
するので、「D:\年度集計」というフォルダに入っている
全てのファイルを対象として、上記のように一覧を
自動で作成するようにしたいと思っています。
【42383】Re:複数ファイルから一つのファイルに一...
回答  かみちゃん  - 06/9/8(金) 23:47 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>AAA(15年).xlsの「一覧表」シートの内容
>
>　　　A　　　　B　　　C
>１　あああ　　男　　神奈川
>２　いいい　　女　　東京
>３　ううう　　女　　千葉
>
>AAA(14年).xlsの「一覧表」シートの内容
>
>　　　A　　　　B　　　C
>１　ｑｑｑ　　男　　埼玉
>２　ｐｐｐ　　男　　群馬
>３　ｋｋｋ　　女　　長野
>
>
>これを「年度集計.xls」の「全件一覧」シートに
>繋げてコピーしたいのです。
>
>　　　A　　　　B　　　C
>１　あああ　　男　　神奈川
>２　いいい　　女　　東京
>３　ううう　　女　　千葉
>４　ｑｑｑ　　男　　埼玉
>５　ｐｐｐ　　男　　群馬
>６　ｋｋｋ　　女　　長野
>
>このような感じです。

「年度集計.xls」に以下のようなコードを記述し、、「D:\年度集計」フォルダに
保存し一度閉じて、そのあと、実行してみてください。

Sub Macro1()
　Dim strPath As String
　Dim strFileName As String
　Dim vntData As Variant
　Dim rngResult As Range
　　
　strPath = ThisWorkbook.Path & "\"
　
　strFileName = Dir(strPath & "AAA*.xls")
　Do Until strFileName = ""
　　If strFileName <> ThisWorkbook.Name Then
　　　Workbooks.Open Filename:=strPath & strFileName
　　　vntData = Sheets("一覧表").Range("A1").CurrentRegion.Value
　　　With ThisWorkbook.Sheets("全件一覧")
　　　　Set rngResult = .Range("A1")
　　　　If .Range("A1").Value <> "" Then
　　　　　Set rngResult = .Cells(Rows.Count, 1).End(xlUp)
　　　　End If
　　　　rngResult.Resize(UBound(vntData, 1), UBound(vntData, 2)).Value = vntData
　　　End With
　　　Erase vntData
　　　ActiveWorkbook.Close
　　End If
　　strFileName = Dir()
　Loop
End Sub
【42384】Re:複数ファイルから一つのファイルに一...
発言  ponpon  - 06/9/9(土) 0:15 -
引用なし
パスワード
   すでにかみちゃんから回答がありますが・・・
一応作ってみたので、年度集計.xlsの標準モジュールに
コピペして、実行してみてください。
配列を利用したかみちゃんのものより遅いと思いますが・・

Sub test()
　　Dim myFile As String
　　Dim myWB As Workbook
　　Const myPath As String = "D:\年度集計"
　
　　Application.ScreenUpdating = False
　　myFile = Dir(myPath & "\" & "AAA*.xls")
　　If myFile = "" Then
　　　 MsgBox "AAAのつくファイルはありません。"
　　Else
　　　　 With ThisWorkbook.Sheets("全件一覧")
　　　　　　.Cells.ClearContents
　　　　　　.Range("A1:C1").Value = Array("氏名", "男女", "県名")
　　　　 End With
　　　　 Do While myFile <> ""
　　　　　 Set myWB = Workbooks.Open(myPath & myFile)
　　　　　　　 With myWB.Sheets("一覧表")
　　　　　　　　　.Range("A1", .Range("C65536").End(xlUp)).Copy _
　　　　　　　　　ThisWorkbook.Sheets("全件一覧").Range("A65536").End(xlUp).Offset(1)
　　　　　　　 End With
　　　　　　　 myWB.Close
　　　　　 myFile = Dir()
　　　　 Loop
　　End If
　　Application.ScreenUpdating = True
　　Set myWB = Nothing

End Sub
【42420】Re:複数ファイルから一つのファイルに一...
お礼  やふーー  - 06/9/11(月) 9:15 -
引用なし
パスワード
   かみちゃんさん
ponponさん

お二人ともありがとうございます。
どちらも、私のやりたかった事がバッチリできました！

本当にありがとうございます。
【42427】Re:複数ファイルから一つのファイルに一...
質問  やふーー  - 06/9/11(月) 17:04 -
引用なし
パスワード
   ▼ponpon さん：

お礼を書いた後でも申し訳ないのですが、
ponponさんの式で、
「氏名の欄（Ａ列）が空欄だったらそのファイルからの抽出を終了」
という形にするには、どうしたら良いでしょう？

一覧表に、不要なデータがある事に気が付いたため、
純粋にデータだけど取りたいと思いまして・・・。

また、抽出の際にコピーではなく「形式を選択して貼り付け」で
言うところの「値」として抽出したいのですが。（参照している
項目があったため、コピー後にブックを参照してしまう。）

よろしくお願いします。


Sub test()
　　Dim myFile As String
　　Dim myWB As Workbook
　　Const myPath As String = "D:\年度集計"
　
　　Application.ScreenUpdating = False
　　myFile = Dir(myPath & "\" & "AAA*.xls")
　　If myFile = "" Then
　　　 MsgBox "AAAのつくファイルはありません。"
　　Else
　　　　 With ThisWorkbook.Sheets("全件一覧")
　　　　　　.Cells.ClearContents
　　　　　　.Range("A1:C1").Value = Array("氏名", "男女", "県名")
　　　　 End With
　　　　 Do While myFile <> ""
　　　　　 Set myWB = Workbooks.Open(myPath & myFile)
　　　　　　　 With myWB.Sheets("一覧表")
　　　　　　　　　.Range("A1", .Range("C65536").End(xlUp)).Copy _
　　　　　　　　　ThisWorkbook.Sheets("全件一覧").Range("A65536").End(xlUp).Offset(1)
　　　　　　　 End With
　　　　　　　 myWB.Close
　　　　　 myFile = Dir()
　　　　 Loop
　　End If
　　Application.ScreenUpdating = True
　　Set myWB = Nothing

End Sub
【42430】Re:複数ファイルから一つのファイルに一...
発言  ponpon  - 06/9/11(月) 22:58 -
引用なし
パスワード
   ▼やふーー さん：
>ponponさんの式で、
>「氏名の欄（Ａ列）が空欄だったらそのファイルからの抽出を終了」
>という形にするには、どうしたら良いでしょう？
 ★印を追加
A2の値を見ていますが、A2が空欄だったら転記しないで良いのでしょうか？

>また、抽出の際にコピーではなく「形式を選択して貼り付け」で
>言うところの「値」として抽出したいのですが。（参照している
>項目があったため、コピー後にブックを参照してしまう。）

PasteからPastespecialに変えています。

それと"\"が抜けていました。

>
>Sub test()
>　　Dim myFile As String
>　　Dim myWB As Workbook
>　　Const myPath As String = "D:\年度集計"
>　
>　　Application.ScreenUpdating = False
 　　myFile = Dir(myPath & "\" & "AAA*.xls")
>　　If myFile = "" Then
>　　　 MsgBox "AAAのつくファイルはありません。"
>　　Else
>　　　　 With ThisWorkbook.Sheets("全件一覧")
>　　　　　　.Cells.ClearContents
>　　　　　　.Range("A1:C1").Value = Array("氏名", "男女", "県名")
>　　　　 End With
>　　　　 Do While myFile <> ""
 　　　　　 Set myWB = Workbooks.Open(myPath & "\" & myFile)　'"\"が抜けていました
>　　　　　　　 With myWB.Sheets("一覧表")
　　　　　　　　　If .Range("A2").Value <> "" Then　'★
　　　　　　　　　　 .Range("A1", .Range("C65536").End(xlUp)).Copy
　　　　　　　　　　 ThisWorkbook.Sheets("全件一覧").Range("A65536") _
　　　　　　　　　　 .End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
　　　　　　　　　End If　'★　　　　　　　
>　　　　　　　 End With
>　　　　　　　 myWB.Close
>　　　　　 myFile = Dir()
>　　　　 Loop
>　　End If
>　　Application.ScreenUpdating = True
>　　Set myWB = Nothing
>
>End Sub
【42440】Re:複数ファイルから一つのファイルに一...
質問  やふーー  - 06/9/12(火) 9:38 -
引用なし
パスワード
   ▼ponpon さん：

度々すいません。
コピーの方はＯＫでした。

終了判定について、
>A2の値を見ていますが、A2が空欄だったら転記しないで良いのでしょうか？

「Ａ２にデータが入っていないファイルは終了」ではなく、
「Ｂ列、Ｃ列にまだデータが残っていても、Ａ列のデータが
入っていなかったら、そのファイルからの抽出は終了」と
したいと思っています。
ファイルによっては、件数がバラバラなので１０件抽出したり
２０件抽出したりとなります。
また、Ｂ列やＣ列は、常に３０件のデータが入ってしまっているため、
Ａ列のデータが無くなるまで抽出を繰り返したいというわけなのです。

AAA(15年).xlsの「一覧表」シートの内容

　　　A　　　　B　　　C
１　あああ　　男　　神奈川
２　いいい　　女　　東京
３　　　　　　女　　千葉　　←このデータはＡ列にデータが無いため、
　　　　　　　　　　　　　　　Ｂ、Ｃ列にデータが残っていても抽出しないで終了
　　　　　　　　　　　　　　（ファイルも閉じる）


すいません、よろしくお願いいたします。
【42441】Re:複数ファイルから一つのファイルに一...
発言  ponpon  - 06/9/12(火) 10:36 -
引用なし
パスワード
   ならば、

>Sub test()
>　　Dim myFile As String
>　　Dim myWB As Workbook
>　　Const myPath As String = "D:\年度集計"
>　
>　　Application.ScreenUpdating = False
　　myFile = Dir(myPath & "\" & "AAA*.xls")
>　　If myFile = "" Then
>　　　 MsgBox "AAAのつくファイルはありません。"
>　　Else
>　　　　 With ThisWorkbook.Sheets("全件一覧")
>　　　　　　.Cells.ClearContents
>　　　　　　.Range("A1:C1").Value = Array("氏名", "男女", "県名")
>　　　　 End With
>　　　　 Do While myFile <> ""
>　　　　　 Set myWB = Workbooks.Open(myPath & "\" & myFile)　
>　　　　　　　 With myWB.Sheets("一覧表")
>　　　　　　　　　If .Range("A2").Value <> "" Then　
　　　　　　　　　　 .Range("A1", .Range("A65536").End(xlUp)).Resize(,2).Copy
>　　　　　　　　　　 ThisWorkbook.Sheets("全件一覧").Range("A65536") _
>　　　　　　　　　　 .End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
>　　　　　　　　　End If　　　　　　　　
>　　　　　　　 End With
>　　　　　　　 myWB.Close
>　　　　　 myFile = Dir()
>　　　　 Loop
>　　End If
>　　Application.ScreenUpdating = True
>　　Set myWB = Nothing
>
>End Sub
【42444】Re:複数ファイルから一つのファイルに一...
質問  やふーー  - 06/9/12(火) 10:56 -
引用なし
パスワード
   ▼ponpon さん：
早速ありがとうございます。

入れてみたのですが、ちょっと結果がうまくいかなかったです。
もう少し例を入れてみます。

AAA(15年).xlsの「一覧表」シートの内容
　　　A　　　　B　　　C
１　あああ　　男　　神奈川
２　いいい　　女　　東京
３　　　　　　女　　---
４　　　　　　男　　---

AAA(14年).xlsの「一覧表」シートの内容
　　　A　　　　B　　　C
１　ＰＰＰ　　男　　神奈川
２　ＷＷＷ　　女　　埼玉
３　ＵＵＵ　　女　　北海道
４　ＱＱＱ　　男　　沖縄
５　　　　　　男　　---
６　　　　　　女　　---

抽出結果としては、

　　　A　　　　B　　　C
１　あああ　　男　　神奈川
２　いいい　　女　　東京
３　ＰＰＰ　　男　　神奈川
４　ＷＷＷ　　女　　埼玉
５　ＵＵＵ　　女　　北海道
６　ＱＱＱ　　男　　沖縄

こんな感じです。　　
AAA(15年).xlsは、３番目に名前が無いので、２件だけ抽出
AAA(14年).xlsは、５番目に名前が無いので、４件だけ抽出。
合計６件の抽出結果。

度々すいませんが、よろしくお願いいたします。
【42448】Re:複数ファイルから一つのファイルに一...
発言  ponpon  - 06/9/12(火) 13:15 -
引用なし
パスワード
   失礼しました。

Sub test()
　　Dim myFile As String
　　Dim myWB As Workbook
　　Const myPath As String = "D:\年度集計"

　　Application.ScreenUpdating = False
　　myFile = Dir(myPath & "\" & "AAA*.xls")
　　If myFile = "" Then
　　　 MsgBox "AAAのつくファイルはありません。"
　　Else
　　　　 With ThisWorkbook.Sheets("全件一覧")
　　　　　　.Cells.ClearContents
　　　　　　.Range("A1:C1").Value = Array("氏名", "男女", "県名")
　　　　 End With
　　　　 Do While myFile <> ""
　　　　　 Set myWB = Workbooks.Open(myPath & "\" & myFile)
　　　　　　　 With myWB.Sheets("一覧表")
　　　　　　　　　　 .Range("A1", .Range("A65536").End(xlUp)).Resize(, 3).Copy
　　　　　　　　　　 ThisWorkbook.Sheets("全件一覧").Range("A65536") _
　　　　　　　　　　 .End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
　　　　　　　 End With
　　　　　　　 myWB.Close
　　　　　 myFile = Dir()
　　　　 Loop
　　End If
　　Application.ScreenUpdating = True
　　Set myWB = Nothing

End Sub
【42456】Re:複数ファイルから一つのファイルに一...
質問  やふーー  - 06/9/12(火) 15:58 -
引用なし
パスワード
   ▼ponpon さん：

すいません。
やっぱりうまくいきません。

不要な行まで引っ張ってきてしまいます・・・。
【42457】Re:複数ファイルから一つのファイルに　...
発言  ponpon  - 06/9/12(火) 16:32 -
引用なし
パスワード
   A列の空白は、見かけ上は""でも、計算式の入っているセルがありませんか？
今日は時間がなく、後は深夜か明日になります。
【42468】Re:複数ファイルから一つのファイルに　...
質問  やふーー  - 06/9/12(火) 21:45 -
引用なし
パスワード
   ▼ponpon さん：
>A列の空白は、見かけ上は""でも、計算式の入っているセルがありませんか？
>今日は時間がなく、後は深夜か明日になります。


あ、あります。
IF文で、""を入力してしまっているので、見かけは空欄となってます。
逆に何かサインを入れてしまったほうが、判定しやすいのでしょうか？
【42470】Re:複数ファイルから一つのファイルに　...
発言  ponpon  - 06/9/12(火) 23:30 -
引用なし
パスワード
   ▼やふーー さん：
>あ、あります。
>IF文で、""を入力してしまっているので、見かけは空欄となってます。
>逆に何かサインを入れてしまったほうが、判定しやすいのでしょうか？

やっぱりね。
もっとうまい方法があるかもしれませんが、

Sub test()
　　Dim myFile As String
　　Dim myWB As Workbook
　　Dim FR As Variant
　　Const myPath As String = "D:\年度集計"
　
　　Application.ScreenUpdating = False
　　myFile = Dir(myPath & "\" & "AAA*.xls")
　　If myFile = "" Then
　　　 MsgBox "AAAのつくファイルはありません。"
　　Else
　　　　 With ThisWorkbook.Sheets("全件一覧")
　　　　　　.Cells.ClearContents
　　　　　　.Range("A1:C1").Value = Array("氏名", "男女", "県名")
　　　　 End With
　　　　 Do While myFile <> ""
　　　　　 Set myWB = Workbooks.Open(myPath & "\" & myFile)
　　　　　　　 With myWB.Sheets("一覧表")
　　　　　　　　 FR = Application.Match("", .Range("A:A"), 0)
　　　　　　　　 If IsError(FR) Then
　　　　　　　　　　 .Range("A1", .Range("A65536").End(xlUp)).Resize(, 3).Copy
　　　　　　　　 Else
　　　　　　　　　　 .Range(.Cells(1, 1), .Cells(FR - 1, 3)).Copy
　　　　　　　　 End If
　　　　　　　　　　 ThisWorkbook.Sheets("全件一覧").Range("A65536") _
　　　　　　　　　　 .End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
　　　　　　　 End With
　　　　　　　 myWB.Close
　　　　　 myFile = Dir()
　　　　 Loop
　　End If
　　Application.ScreenUpdating = True
　　Set myWB = Nothing
　　
End Sub
【42491】Re:複数ファイルから一つのファイルに　...
お礼  やふーー  - 06/9/13(水) 11:38 -
引用なし
パスワード
   ▼ponpon さん：

できましたー！！！

ホントに助かりました。
ponponさん、ありがとうございます。

また何かあった際にはよろしくお願いいたします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6913 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free