Excel VBA質問箱 IV

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

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


6892 / 13644 ツリー ←次へ | 前へ→

【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」と名前が
付けてあります。

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

そして、集計用のファイル「年度集計.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
1 あああ  男  神奈川
2 いいい  女  東京
3 ううう  女  千葉

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

   A    B   C
1 qqq  男  埼玉
2 ppp  男  群馬
3 kkk  女  長野


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

   A    B   C
1 あああ  男  神奈川
2 いいい  女  東京
3 ううう  女  千葉
4 qqq  男  埼玉
5 ppp  男  群馬
6 kkk  女  長野

このような感じです。

集めたいファイルの数が処理のたびに増えたり減ったり
するので、「D:\年度集計」というフォルダに入っている
全てのファイルを対象として、上記のように一覧を
自動で作成するようにしたいと思っています。

【42383】Re:複数ファイルから一つのファイルに一...
回答  かみちゃん  - 06/9/8(金) 23:47 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>AAA(15年).xlsの「一覧表」シートの内容
>
>   A    B   C
>1 あああ  男  神奈川
>2 いいい  女  東京
>3 ううう  女  千葉
>
>AAA(14年).xlsの「一覧表」シートの内容
>
>   A    B   C
>1 qqq  男  埼玉
>2 ppp  男  群馬
>3 kkk  女  長野
>
>
>これを「年度集計.xls」の「全件一覧」シートに
>繋げてコピーしたいのです。
>
>   A    B   C
>1 あああ  男  神奈川
>2 いいい  女  東京
>3 ううう  女  千葉
>4 qqq  男  埼玉
>5 ppp  男  群馬
>6 kkk  女  長野
>
>このような感じです。

「年度集計.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さんの式で、
「氏名の欄(A列)が空欄だったらそのファイルからの抽出を終了」
という形にするには、どうしたら良いでしょう?

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

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

よろしくお願いします。


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さんの式で、
>「氏名の欄(A列)が空欄だったらそのファイルからの抽出を終了」
>という形にするには、どうしたら良いでしょう?
★印を追加
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 さん:

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

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

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

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

   A    B   C
1 あああ  男  神奈川
2 いいい  女  東京
3      女  千葉  ←このデータは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
1 あああ  男  神奈川
2 いいい  女  東京
3      女  ---
4      男  ---

AAA(14年).xlsの「一覧表」シートの内容
   A    B   C
1 PPP  男  神奈川
2 WWW  女  埼玉
3 UUU  女  北海道
4 QQQ  男  沖縄
5      男  ---
6      女  ---

抽出結果としては、

   A    B   C
1 あああ  男  神奈川
2 いいい  女  東京
3 PPP  男  神奈川
4 WWW  女  埼玉
5 UUU  女  北海道
6 QQQ  男  沖縄

こんな感じです。  
AAA(15年).xlsは、3番目に名前が無いので、2件だけ抽出
AAA(14年).xlsは、5番目に名前が無いので、4件だけ抽出。
合計6件の抽出結果。

度々すいませんが、よろしくお願いいたします。

【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さん、ありがとうございます。

また何かあった際にはよろしくお願いいたします。

6892 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free