エクセル：別シートの複数ある同じデータを一発検索したい！

長文ですみません。
家計簿を我流でエクセル管理しています。日々の支出のみのシートは、列に日を、行には摘要、数量、金額、分類、などを入れるスタイルです。日が前後してもあとで並べ替えできるのでどんどん思いつきで羅列しています。
ちなみにブックの構成は、上記の出納帳のようなシートのほかに、そのシートのデータを月別にわけた複数のシートと、携帯電話支払い金額や、保険、教育費、光熱費のそれぞれのシート、収入をまとめたシート、そしてそれらをリンクさせてきてまとめた合計金額シート、などからなっています。ピボットテーブルも月の締めくくりで使っていますが、これとはまた求めるものが違うので・・・。
質問事項は、上記の月別にわけた複数シートから、データの中で何度も出る品名について過去のデータの金額の傾向を調べたいのです。イメージとしては、別の画面上で検索ボタンに目的の品名を入れると、複数のシートから探してきてすべてを一覧表示させていついつに、どんな値段で購入されているかがわかるようにさせたいのです。簡単な関数なら扱えるようになっていますが、教えてください。わかりにくければまた補足いたしましう。よろしくお願いいたします！

No.4 ベストアンサー 回答者： matsu_jun 回答日時： 2005/02/20 14:45

マクロを作りました。

実行すると以下の動作をします
1) 検索文字列を入力してもらうためのウィンドウが表示されます
　　この際、完全に一致するものだけを選びたい時はそのまま
　　一部だけが含まれているものであれば選びたい時は頭に「*」を入力してから入力
　　(例 「携帯電話」を含む項目を選びたい時は、「*携帯電話」と入力
2) OKを押すと検索が始まります。
3) 何も選択せずに、あるいは「*」のみを入力して検索を始めた場合
　　「キーワードを入力してください」というメッセージと共に終了します。
　　この場合は再度マクロを実行しなおして下さい。
4) 検索が終了すると、末尾にシート「検索結果」が作成され、一覧が表示されます。
　　既に「検索結果」シートがある場合(2回目以降の検索)、以前の検索結果が消去され、新しい条件での検索結果が表示されます。

前提条件
1) 現存する全てのシートは同じ列に同じ項目が入っていること
　　(品名があるシートではB列、別のシートではC列などとなりますと、どちらか一方は検索対象外となります)
　　その場合は、下のソースの「項目列」を0としていただくと、不要なデータまで検索される恐れがあるものの
　　一応検索は可能となります。
2) 下のソースから、「検索列」および「項目数」を設定してもらいます。
　　デフォルトでは、C列が「摘要」であると仮定し、C列から検索をすることになっています。

下記コードの貼り付け方、実行方法が分からない場合は、
http://okweb.jp/kotaeru.php3?q=1219526
の#2および#4を参照してください。


'ここから--------------------------------------------------------

Sub 複数シート検索()

'変数定義 ( 検索したい列と、シートの項目数を設定します )
'以下の2行を必要に応じて変更してください
検索列# = 3
項目数# = 6
'注 検索列について
'　上の例では、C列を検索することになっています。列のアルファベットを半角数字に直したものを入れます。
'　　例 E列を検索したい時は、検索列# = 5 とします。
'　　検索列# = 0 とすると、全列から検索します。
'注 項目数について
'　上の例では、A列からF列までの6列を検索結果シートにコピーし、G列にシート名を記入します。
'　1以上の半角数字を入れてください
'　途中の列からコピーを開始することはできません。


'以下 変更しないでください
'検索したい文字列を入力するInputBoxを表示する
SRCTXT$ = Application.InputBox _
("キーワードを入力してください" & Chr(13) & "(一部を含む検索の場合は、語頭に「*」を入力)", "検索")
Dim WHLSRC As Boolean
If SRCTXT = Empty Then
MsgBox ("キーワードを入力してください")
Exit Sub
Else
If Left(SRCTXT, 1) = "*" Then
If Len(SRCTXT) = 1 Then
MsgBox ("キーワードを入力してください")
Exit Sub
Else
WHLSRC = False
End If
Else
WHLSRC = True
End If
End If
Application.ScreenUpdating = False
On Error GoTo ERREND
SHTNUM# = Worksheets.Count
If Worksheets(SHTNUM).Name = "検索結果" Then
'シート最後尾に既に検索結果シートがある場合、その内容をクリアする
Worksheets("検索結果").Cells.Delete
SHTNUM = SHTNUM - 1
Else 'シート最後尾に検索結果シートがない場合、新規にシートを作成する
Worksheets.Add After:=Worksheets(SHTNUM)
Worksheets(SHTNUM).Name = "検索結果"
End If
'検索結果シートに見出しを挿入
For i# = 1 To 項目数
Worksheets("検索結果").Cells(1, i).Value = Worksheets(1).Cells(1, i).Value
Next i
Worksheets("検索結果").Cells(1, 項目数 + 1).Value = "シート名"
'各シート毎に検索を開始し、検索結果を「検索結果」シートに挿入
K_LINE# = 2
Dim KENCOL1, KENCOL2 As Integer
If 検索列 = 0 Then
KENCOL1 = 1
KENCOL2 = 項目数
Else
KENCOL1 = 検索列
KENCOL2 = 検索列
End If
For i = 1 To SHTNUM
With Worksheets(i).Range(Worksheets(i).Cells(1, KENCOL1), Worksheets(i).Cells(65536, KENCOL2))
If WHLSRC = True Then
Set x = .Find(SRCTXT, Lookat:=xlWhole)
Else
Set x = .Find(SRCTXT, Lookat:=xlPart)
End If
If Not x Is Nothing Then
FSTADD = x.Address
For j# = 1 To 項目数
Worksheets("検索結果").Cells(K_LINE, j).Value = Worksheets(i).Cells(x.Row, j).Value
Worksheets("検索結果").Cells(K_LINE, 項目数 + 1).Value = Worksheets(i).Name
Next j
K_LINE = K_LINE + 1
Do
Set x = .FindNext(x)
If x.Address = FSTADD Then Exit Do
For j = 1 To 項目数
Worksheets("検索結果").Cells(K_LINE, j).Value = Worksheets(i).Cells(x.Row, j).Value
Worksheets("検索結果").Cells(K_LINE, 項目数 + 1).Value = Worksheets(i).Name
Next j
K_LINE = K_LINE + 1
Loop While Not x Is Nothing
End If
End With
Next i
'検索結果シートを前面に表示
Worksheets("検索結果").Activate
Application.ScreenUpdating = True
Exit Sub
ERREND:
Application.ScreenUpdating = True
MsgBox ("エラー" & Chr(13) & "設定が間違っていませんか?")
End Sub

'ここまで--------------------------------------------------------

参考URL：http://okweb.jp/kotaeru.php3?q=1219526

この回答への補足

ありがとうございます！私などのために大切な時間を費やして下さって感謝します。今みたばかりなので、少し自分でやってみようと思います。結果はまたお礼の方でさせていただきます。かなり時間がかかりそうなので、すぐにはお礼に書き込めないかもしれませんが・・・

補足日時：2005/02/20 14:52

No.5 回答者： macchan1 回答日時： 2005/02/20 17:45

ご自分の力でマクロで処理する場合は、このような感じのアプローチが簡単で良いと思います。

1）マクロの記録を利用し、項目名だけがついた作業用シートにまず1月分のシートのデータを大き目の範囲（例えばA2からC1000まで）をコピー、ペーストする。
2）同様に2月分のシートのA2からC1000までを作業用シートのA1001にコピー貼り付けし、12月までのデータを同様に1000行ずつ下のセルに貼り付けます。
3）この作業用シートの空白行を含むすべてのデータ範囲を指定し、オートフィルタで希望のデータを抽出し、抽出されたデータを指定の位置にコピー、貼り付けします。
4）最後に作業用シートのフィルタを解除ておく。

これで基本的マクロの準備が完了です。
自動記録で書かれたコードの検索文字の部分を編集して（Criteria1:=の右辺に代入）、この部分を検索したいデータの入っているシートのセル番地やインプットボックスの値などに置き換えればOKです。

作業用のシートは最終的に非表示にしておくと良いと思います。

上記のマクロコードは、実際はもっと合理的なものにすることができますが、コードの編集操作をできる限り簡単にするために例示しました。

追伸：SUMPRODUCT関数や配列数式を多用するとその再計算に時間がかかることがありますが、オートフィルタの操作に時間がかかることは無いと思うのですが・・・。

No.3 回答者： macchan1 回答日時： 2005/02/20 14:24

＃2の補足です。

もし、あるシートのある列にある特定のデータを別シートに一覧として引っぱってきたい場合はこのサイトの別の質問で私が回答したような方法を用います。

複数シートから抽出する場合は、もし該当データが無い場合は、次のシートを検索するというようなIF関数を用いて、表示させることができますが、非常に複雑な式となるだけでなく、シート数が増えた場合は式の長さやネスト（例えばIF関数での条件数）の条件をクリアする必要も出てきます。
このような場合は補助列などを使って式を簡素化する必要がありますが、実際はマクロで対応するほうが簡単だと思います（紹介した質問例の他の方の回答も参考にして下さい）

参考URL：http://oshiete1.goo.ne.jp/kotaeru.php3?q=1227504

No.2 回答者： macchan1 回答日時： 2005/02/20 12:27

例えば3つのシートから特定の項目を別シートに抽出するようなことはできますが,シート数が多くなると関数だけでは簡単にはできません（ものすごく複雑な式を利用すれば今回のケースでもできる可能性はあります）。

このような場合はマクロで対応することになりますが、現在、別シートに月ごとのデータを入れているならこれを1つのシートにまとめることが、管理を含めて種々の観点から最も重要なことです。

このようにしておけば、月ごとの項目別収支などがピボットテーブルのグループ化を利用すれば簡単に分類できます。
もちろん月ごとのシートもオートフィルタとマクロ（の記録）で簡単に作成できます。

今回のようなケースで、必要な項目だけのデータを抽出する場合も、比較的簡単な関数だけで対応データを抽出することが可能です（もちろんオートフィルタやフィルタオプションの設定でもできますが）。

ご検討ください。

No.1 回答者： 0shiete 回答日時： 2005/02/20 11:48

一覧標示させるには、全てのデータが一つのシート上にないと無理なのではないでしょうか？

関数はお使いになれるということなので、少し手間ですが、検索用のシートに=Sheet1!a1などと別シートの値を持ってくるようにして、これをずらーっと行方向に並べます。行方向に日付、列方向に摘要、数量、金額、分類が来るようにしてください。

その後、オートフィルタを使って項目ごとの履歴を見ることができます。

VBAを使ってもよいなら、また別の方法があります。

この回答への補足

オートフィルタを使う方法以外にないかと思ったもので・・・というのは、データを月別にシートでたとえば12か月分作っていたとして、その分には、一シートごとにはデータが少ないのでそうでもないのですが、一年間分をひとつのシートに（一年にくぎらなくてもずっと）蓄積していると、オートフィルタは反応がにぶく、じれったいのですね・・・・もしできれば参考までにＶＢＡで作った場合を教えていただけますか？私にできるかどうかわからないのですが、挑戦してみたいです！

補足日時：2005/02/20 14:54