Excell で、複数のシート間にあるデータを抽出する

複数のシートの中から、ある共通のひとつのデータを抽出する場合、該当シートを全部選択して検索すれば出ますが、そのあと、これらを改めて新しいシートに記録するにはどうすればよいでしょうか？今はそれがわからないので、検索で出たデータをひとつひとつ見て別シートに入力している状態でじれったいのですが。。。

No.8 回答者： kazuhiko5681 回答日時： 2002/11/22 00:52

こんばんわ。

早速サンプルマクロを組んでみました。次のように操作してみて下さい。

・新規ブックを立ち上げ、ブック名を個別仕入として上書き保存をする。
・データの入っているブックを立ち上げ、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を開き、画面左上のVBAProjectと書かれている下のSheet1と書かれている上でダブルクリックし、表示された右側の白い部分に下記のコードをコピー＆ペーストする。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myCnt As Integer
Dim i As Integer
Dim myWsn As Worksheet
Dim j As Integer
Dim myNum As Integer
Dim myRow As Integer

If Target.Address <> "$A$1" Then Exit Sub

myCnt = Workbooks("抽出データ.xls").Worksheets.Count
For i = 1 To myCnt
If Workbooks("抽出データ.xls").Worksheets(i).Name = "Sheet" & i Then
Workbooks("抽出データ.xls").Worksheets(i).Name = Workbooks("過去データ.xls").Worksheets(i).Range("A1").Value
Set myWsn = Workbooks("抽出データ.xls").Worksheets(i)
Workbooks("過去データ.xls").Worksheets(1).Cells.Copy Destination:=myWsn.Cells
GoTo Line1
End If
Next i

For Each myWsn In Workbooks("抽出データ.xls").Worksheets
If myWsn.Name = Workbooks("過去データ.xls").Worksheets(1).Range("A1").Value Then
GoTo Line1
End If
Next myWsn

Workbooks("抽出データ.xls").Worksheets.Add after:=Workbooks("抽出データ.xls").Worksheets(Workbooks("抽出データ.xls").Worksheets.Count)
ActiveSheet.Name = Workbooks("過去データ.xls").Worksheets(1).Range("A1").Value
Set myWsn = ActiveSheet

Line1:
myCnt = Workbooks("過去データ.xls").Worksheets.Count
For i = 1 To myCnt
myNum = Workbooks("過去データ.xls").Worksheets(i).Cells(Rows.Count, 2).End(xlUp).Row
For j = 1 To myNum
If Workbooks("過去データ.xls").Worksheets(i).Range("A1").Value = Workbooks("過去データ.xls").Worksheets(i).Cells(j, 4).Value Then
myRow = myWsn.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Workbooks("過去データ.xls").Worksheets(i).Cells(j, 2).EntireRow.Copy _
Destination:=myWsn.Cells(myRow, 1)
End If
Next j
Next i

End Sub

・再度ＡＬＴ＋Ｆ11　キーを押してエクセルの画面にもどり、シート１のＡ１にりんごと入力し、フォーカスをＢ1に移動する。
これでマクロが走って貴方様の思った動作が実現できていると思います。

もしご不明な点・不具合等がございましたら、ご遠慮なくお知らせ下さい。

この回答への補足

A1セルに入力すると、マクロが走り、データが出てきました。成功したようです！ありがとうございました。まだもう少し、いろいろ試してみたいので、補足に書き込みましたが、またお礼もさせて頂きます。

補足日時：2002/11/23 14:45

No.7 回答者： kazuhiko5681 回答日時： 2002/11/20 02:54

こんばんわ。

貴方様が実行した方法ではエラーが出るかと思います。度々申し訳ございませんが、次の内容をもう一度教えていただきたくお願いいたします。

・データが入力されているブック名と各シートのＡ列から順番に項目名
・抽出したデータを貼り付けるために用意したブックのブック名
・検索するデータが入力されている列番号
・検索キーワードを入力するために、Ａ１セルを利用してよいか。
　この方法を使うと２行目が項目名を入力する行になり、データは３行目から入力することになります。

次に、動作の確認をしたいと思います。検索対象となるデータがＢ列に入力されていていると仮定して説明させていただきます。

・データが入力されているブックにあるすべてのシートのＢ列を検索し、一致した時その行の書かれているすべてのデータを選択する。
・もう一方のブックに検索キーワードごとにシートを用意し、そのシートに順番に選択されたデータを貼り付ける。

このような動作でよろしいのかどうか貴方様のご意見をお聞かせ下さい。

お手数をおかけいたしますが、よろしくお願いいたします。

この回答への補足

こんばんわ　ありがとうございます。

・データが入力されているブック名と各シートのＡ列から順番に項目名

ブック名は「過去データ」です。シートはＡより順番に、伝票番号、日付、商品名、単価、数量、金額　となります。

・抽出したデータを貼り付けるために用意したブックのブック名
「抽出データ」


・検索するデータが入力されている列番号

Ｄ列

・検索キーワードを入力するために、Ａ１セルを利用してよいか。
　この方法を使うと２行目が項目名を入力する行になり、データは３行目から入力することになります。

その通りの方法を使っています。

次に、動作の確認をしたいと思います。検索対象となるデータがＢ列に入力されていていると仮定して説明させていただきます。

・データが入力されているブックにあるすべてのシートのＢ列を検索し、一致した時その行の書かれているすべてのデータを選択する。
・もう一方のブックに検索キーワードごとにシートを用意し、そのシートに順番に選択されたデータを貼り付ける。

このような動作でよろしいのかどうか貴方様のご意見をお聞かせ下さい。

はい、それで結構です。
ありがとうございました。

補足日時：2002/11/21 00:29

No.6 回答者： kazuhiko5681 回答日時： 2002/11/19 08:38

おはようございます。

とりあえずサンプルマクロを途中まで作ってみました。まだ完成品ではありません。動作するかどうか次の方法で確認してみて下さい。下記の通りに忠実に操作しないと不具合が出る場合がありますのでくれぐれも指示に従って下さい。

・新規ブックを立ち上げ、ブック名を個別仕入として上書き保存をする。
・データの入っているブックを立ち上げ、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を開き、画面左上のVBAProjectと書かれている下のSheet1と書かれている上でダブルクリックし、表示された右側の白い部分に下記のコードをコピー＆ペーストする。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myCnt As Integer
Dim i As Integer
Dim myWsn As Worksheet
Dim j As Integer
Dim myNum As Integer
Dim myRow As Integer

If Target.Address <> "$A$1" Then Exit Sub

myCnt = Workbooks("個別仕入.xls").Worksheets.Count
For i = 1 To myCnt
If Workbooks("個別仕入.xls").Worksheets(i).Name = "Sheet" & i Then
Workbooks("個別仕入.xls").Worksheets(i).Name = Workbooks("仕入台帳.xls").Worksheets(i).Range("A1").Value
Set myWsn = Workbooks("個別仕入.xls").Worksheets(i)
Workbooks("仕入台帳.xls").Worksheets(1).Cells.Copy Destination:=myWsn.Cells
GoTo Line1
End If
Next i

For Each myWsn In Workbooks("個別仕入.xls").Worksheets
If myWsn.Name = Workbooks("仕入台帳.xls").Worksheets(1).Range("A1").Value Then
GoTo Line1
End If
Next myWsn

Workbooks("個別仕入.xls").Worksheets.Add after:=Workbooks("個別仕入.xls").Worksheets(Workbooks("個別仕入.xls").Worksheets.Count)
ActiveSheet.Name = Workbooks("仕入台帳.xls").Worksheets(1).Range("A1").Value
Set myWsn = ActiveSheet

Line1:
myCnt = Workbooks("仕入台帳.xls").Worksheets.Count
For i = 1 To myCnt
myNum = Workbooks("仕入台帳.xls").Worksheets(i).Cells(Rows.Count, 2).End(xlUp).Row
For j = 1 To myNum
If Workbooks("仕入台帳.xls").Worksheets(i).Range("A1").Value = Workbooks("仕入台帳.xls").Worksheets(i).Cells(j, 2).Value Then
myRow = myWsn.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Workbooks("仕入台帳.xls").Worksheets(i).Cells(j, 2).EntireRow.Copy _
Destination:=myWsn.Cells(myRow, 1)
End If
Next j
Next i

End Sub

・再度ＡＬＴ＋Ｆ11　キーを押してエクセルの画面にもどり、シート１のＡ１にりんごと入力し、フォーカスをＢ1に移動する。
これでマクロが走って貴方様の思った動作が実現できていると思います。

もし、うまく動作しない時は、
データが入力されているシートの構成を教えて下さい。
(例：Ａ列に○○・Ｂ列に××というように)
もしきちんと動作した場合は、その旨を教えて下さい。

お手数をおかけいたします。よろしくお願いいたします。

この回答への補足

試してみました。

Workbooks("個別仕入.xls").Worksheets(i).Name = Workbooks("仕入台帳.xls").Worksheets(i).Range("A1").Value
この行でエラーが出ているようです。インデックスが有効範囲にありません。実行時エラー９、というメッセージが出ました。

そのまま何も変えずにコピー＆ペーストしましたが、この仕入台帳というのは、元のブックの名前でしょうか？それならこちらのファイル名に変えないといけないのですか？
それと、元のデータは一行目がタイトルになっています。
Ａ列＝番号、Ｂ列＝日付、Ｃ列＝商品名、、、という風に。なので、データは２行目から続いていきます。
何度もすみませんが、またよろしくお願いします。

補足日時：2002/11/19 15:26

No.5 回答者： kazuhiko5681 回答日時： 2002/11/18 15:00

こんにちは。

お手数をおかけいたしますが、補足をお願いいたします。
・りんごというキーワードで検索する場所を教えて下さい。
・あと検索で一致した時の処理ですが、一致したデータを集めたシートは一度目を通したら破棄してもよろしいのでしょうか？
・もし一致したデータを集めたシートを保存しておく必要がある場合、別ブックのシートにペーストするのではまずいでしょうか？

これがわかり次第、貴方様の思い通りの動作をするサンプルマクロを組んでみたいと思います。

この回答への補足

ありがとうございます！
＞・りんごというキーワードで検索する場所を教えて下さい
ひとつのブックの中の（例えば）５枚のシート全部からです。私がわかっているのは、シートを１から５まで選択し、編集→検索→りんごと入力→すべて検索　でデータの一覧が出てくる、というやり方です。各シートには約２０００行くらいのレコードがあります。何のデータかというと、一か月分の仕入れ商品の納品書からのデータで、一シート一か月分で閉めているので毎月シートが増えていくわけです。それで、仕事上、ひとつの商品の過去の仕入れ状況をつかむために、このような質問をさせて頂いたわけです。
＞・あと検索で一致した時の処理ですが、一致したデータを集めたシートは一度目を通したら破棄してもよろしいのでしょうか？
保存したいです。
＞・もし一致したデータを集めたシートを保存しておく必要がある場合、別ブックのシートにペーストするのではまずいでしょうか？
それで十分です。別ブックにペーストした後、またフルに
その情報は活用していきたいと思っています。

以上、あつかましくいろいろとお聞きしていますが、よろしくお願いいたします！！

補足日時：2002/11/18 15:16

No.4 回答者： kazuhiko5681 回答日時： 2002/11/18 12:56

こんにちは。

早速補足していただいたのですが、まだ貴方様のおやりになりたいことが頭の中に浮かびません。貴方様がおやりになる動作がこちらでも全く同じく実現できるように説明していただけないでしょうか。これができないとマクロを組むことができません。

お手数をおかけいたしますが、よろしくお願いいたします。

この回答への補足

例えば５枚シートがあります。「りんご」というデータが５枚に渡っていろんな所にあるとします。りんごを買った日付、りんご、単価、数量が横一列に表示されている状態です。だから、りんごの情報がどのシートのどこの行にあるかを全部のシートから検索したいのです。もしこれが一枚だけのシートからの検索でしたら、ピボットテーブルでできてしまうのですが、複数シートを選択してのピボットテーブルは、よくわかりません。もし可能なら、マクロの中の文字列に、りんご、とか、きゅうり、とか入れるのを変えるだけで、あちこちにあるりんごのデータの行をひとつのシートに集めて表示するということができればよいのですが。

補足日時：2002/11/18 13:19

No.3 回答者： kazuhiko5681 回答日時： 2002/11/18 11:51

初めまして。

もし私でよろしければ、コピー＆ペーストするだけで貴方様の思い通りの動作をするサンプルマクロを組んでみたいと思います。
ご希望の節は、貴方様のおやりになりたいことを貴方様が現在手操作でおやりになっている順番で詳しく具体的に教えて下さい。

お手数をおかけいたしますが、よろしくお願いいたします。

この回答への補足

ご親切にありがとうございます。要するに、検索で出たいくつかのデータを、そのままエクセル上で反映できればよいのです。検索で出たデータは、セル番地が表示されているだけですよね？そこでシート上では、リンクしてそのデータが指定されている状態ですよね？そのリンクされたデータを横一行そっくり、新しいシートに上から順番に並べていきたいのです。これでもし説明が不十分なら、またご指摘ください。よろしくお願いいたします。

補足日時：2002/11/18 11:56

No.2 回答者： oresama 回答日時： 2002/11/18 11:49

シートごとに

データ→フィルタ→オートフィルタ
で、必要な部分だけ抽出後、コピペする・・・
シートの枚数分だけ、コピペ作業が発生しますが。

No.1 回答者： taknt 回答日時： 2002/11/18 11:30

コピーして貼り付けでいいと思いますよ。

ま、量が多いならば、マクロなどやられたらいいと思いますが、それは
ちょっとむずかしそうですね。

この回答への補足

さっそくのご回答ありがとうございました。コピーペーストのやりかたですと、シートをたくさん選択した状態では
形式が違うのでコピーできないというメッセージが出るのです。複数のシートの選択を解除すれば、コピーができるのですが、そうすると、検索して出たデータをまた一から検索して出さなければならず、かなりの時間がかかるようです。マクロだとルックアップ関数を使うのでしょうか？

補足日時：2002/11/18 11:46