エクセルで別のファイルにあるものをそれぞれ抽出して、ひとつにまとめたいんです。

質問

エクセルに関する質問はたくさんあり、重複しているのか確認してみつつも漏れていたら申し訳ございません。
仕事上で困っております。ぜひ、ご教授ください。

エクセルのデータが２つあります。
ひとつは

　　　Ａ　　Ｂ　　　Ｃ　・・・
１　品番　商品名　納品日
２　N010　　机　　　2008/1/9
３　N009　テープ　　2007/12/29

もうひとつは似たような形なのですが
　　　Ａ　　Ｂ　　　Ｃ　・・・
１　商品名　納品日　品番
２　机　　　2008/1/9　N010
３　テープ　　2007/12/29　N009

とそれぞれ業者から毎日送られてくるものがあります。
並び替えてくっつければ問題ないという意見もありますが、
それぞれを見つつ、全体も見るためにひとつにもまとめたいのです。
さらにそれぞれのファイルには余計なものも付いて来て
（業者によって担当が入っていたり、期日があったり・・・）、
必要な部分行だけを抽出してひとつのファイルにしたいのです。

今回必要なのは
それぞれのA・B・Cなのですが、順番が違うのでどうやって抽出し、ひとつのファイルにまとめることが出来るのでしょうか？

また、毎日更新されてくるので自動的にひとつのまとめたデータのファイルにも更新されると嬉しいのですが・・・。

文章が下手で質問の意図がわかりにくいかと思いますが、
ぜひ、お教えくださいませ。

回答No.3

nekotaru

>とそれぞれ業者から毎日送られてくるものがあります。

特定のフォルダを作成し、上記の送られてくるエクセルファイルのみを入れてください。

先の回答では、
＞検索対象フォルダを指定してください
＞SchFol = "C:\ttmp"
とし、c:\ttmpフォルダを想定しています。
このフォルダを作成してもいいですし、別のフォルダを作って、SchFolの中身を変えていただいてもOKです。

以下はEXCEL2000での手順ですが、大きな違いはないと思います。
EXCEL2007だと手元にないので手順は違うかも知れません。

・エクセルを起動してください。
・ツール→マクロ→Visual Basic Editor（あたらしいウィンドウが起動されます）
・左上にVBAProject(Book1)→Microsoft Excel Object→Sheet1(Sheet1)が表示されていると思います。
・Sheet1(Sheet1)をクリックしてください。中央に何も書かれていないウィンドウが表示されると思います。
・先の回答のOption Explicitから最終行までのEnd Functionを全てコピーし、前行で表示させた何も書かれていない
ウィンドウに貼り付けてください。
▽！！！！▽
２行目の
Public schKEY(3) As String
を
dim schKEY(3) As String
に打ち直してください。打ち直さないとエラーになります。
△！！！！△
・上のツールバーから、実行→sub/ユーザフォームの実行を選択してください。
・新しいフォームが表示され、右に実行ボタンが見えますので、実行ボタンをクリックしてください。
・データ量がどれだけあるかによりますが、しばらくして実行が完了すると、
EXCELシート１に、集計結果が表示されているはずです。

お礼

ご回答いただいたのに、お礼が遅くなり申し訳ございません。
ただ・・・やはり私のＰＣ知識能力では全く頭が追いついておりません。。。。申し訳ございません。

もっと簡単にできるものかと思ってました。
浅はかでした。

回答No.2

nekotaru

こんな感じでしょうか
※一個一個転記してるため、性能は良くないです。
すみません。

Option Explicit

Public schKEY(3) As String

Sub a()

Dim SchFol As String
Dim wsOut As Worksheet
Dim i As Integer

'検索対象フォルダを指定してください
SchFol = "C:\ttmp"

'集計項目を指定してください
schKEY(1) = "商品名"
schKEY(2) = "納品日"
schKEY(3) = "品番"

With Application.FileSearch
.NewSearch
.LookIn = SchFol
.SearchSubFolders = False 'サブフォルダーを検索するときはTRUEにしてください
.Filename = "*.xls"
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then

Set wsOut = Worksheets.Add
With wsOut
For i = 1 To 3
.Cells(1, i).Value = schKEY(i)
Next
End With

For i = 1 To .FoundFiles.Count
Call chkbook(wsOut, .FoundFiles(i))
Next i
Else
MsgBox "検索条件を満たすファイルはありません。"
End If

End With

End Sub

Private Sub chkbook(wsOut As Worksheet, inBook As String)

Dim wbIn As Workbook
Dim wsIn As Worksheet

' Dim eRowA As Long
' Dim eRowB As Long
'
' Dim outCnt As Long
' Dim outRow As Long

Dim rng As Range
Dim eRow As Long
Dim wRow As Long
Dim outRow As Long
Dim wCol As Integer

Workbooks.Open inBook

For Each wbIn In Workbooks
If wbIn.FullName = inBook Then
Exit For
End If
Next

'全シートを調べます
For Each wsIn In wbIn.Worksheets

With wsIn

If .Cells(1, 1) <> "" Then

For wCol = 1 To 3
Set rng = .Rows(1).Find(what:=schKEY(wCol))
If rng Is Nothing Then
'見つからない場合
MsgBox (schKEY(wCol) & "が見つかりません")
Else
'見つかった場合
eRow = eRowGet(wsIn, rng.Column)
outRow = eRowGet(wsOut, wCol)
For wRow = 2 To eRow
outRow = outRow + 1
wsOut.Cells(outRow, wCol).Value = .Cells(wRow, rng.Column).Value
Next
End If
Next
End If

End With
Next
wbIn.Close (False)

End Sub

Private Function eRowGet(ws As Worksheet, wCol As Integer) As Long

With ws.Cells(65536, wCol)
If .Value <> "" Then
eRowGet = 65536
Else
eRowGet = .End(xlUp).Row
End If
End With

End Function

お礼

ありがとうございます。
私、ＰＣに関しての知識不足で申し訳ございませんが
上記をどのようにすればよろしいのですか？
どこかに打ち込めばよろしいのでしょうか？
お教えください！宜しくお願いいたします。

回答No.1

koko88okok

実際には使ったことはありませんが、Excelの「統合」機能が使えるかも知れません。

下記URLのページをご参照下さい。

「統合」
http://kokoro.kir.jp/excel/tougou.html

「１９．データの統合機能を使う」
http://www.excel7.com/chotto19.htm

「Excel(エクセル)基本講座：統合の使い方」
http://www.eurus.dti.ne.jp/~yoneyama/Excel/tougou.html

お礼

ご回答ありがとうございます！
ただ、私の場合は合計値を出したいのではなく、
データベースとして使いたいのです・・・。（質問の説明不足で申し訳ございません。）

統合機能を上手く使いこなせないのが原因なのかもしれませんが、
別ファイルに

N010　机　2008/1/9
N010　机　2008/1/9
N009 テープ　2007/12/29
N009 テープ　2007/12/29

と羅列する形で表示したいのですが・・・。
希望としては品番を基準に並べられたらいいなと思っております。

いただいた回答で可能なのでしょうか？
申し訳ございません、ご教授ください。