エクセルで検索し別シートに抽出したい。2007

質問

http://okwave.jp/qa/q6798171.html

昨日上記URLで質問させて頂き、無事問題は解決。しばらく思い悩んだ件も解決し喜び表を作成していたのですが、大事な事を質問していなかった事に気がつき再度質問させて頂ければと思います。

先のタイトル通りご教授頂いたおかげで、別シートへデータを抽出することができました。
ただ、Sheet1からSheet20まであり、(肝心の部分を書洩らしていました。）残りの19Sheetについては抽出できませんでした。(Sheetは1～20までが同じフォーマット、サイズのもの。別途5Sheetは全く違うもの）
何故かと思い、教えて頂いたVBAを見て調べたところ、標準モジュールへ記述したとき最前面に表示されているワークブックのWorkbookオブジェクトを参照します。との記述を発見し、色々と試してみましたが一度に複数シートを検索抽出する事はできませんでした。

下記で指定したシート名を変更することで、残りのシートも抽出する事は出来たのですが、毎回の作業となるとかなりの時間を要しますので出来れば、指定したシート名を一度に処理出来ればと思います。

Set wS = Worksheets("Sheet2")別シート名へ変更
Application.ScreenUpdating = False
With Worksheets("Sheet1")別シート名へ変更

度々の質問で申し訳ありませんがよろしくお願いします。

回答No.3

tom04 · ベストアンサー

こんばんは！

＞Sheet1からSheet20まであり
また
＞指定したシート名を一度に処理出来ればと思います。
とありますが
結局「指定したシート」に関して操作したい！という解釈での一例です。

今回は表示させたいSheetをSheet見出しの一番左側に配置しておきます。
すなわち検索対象のSheet1～Sheet20はSheet見出しの左から2番目以降に並べてます。
（セル配置は前回のSheet2と同様です）

今回は作業列を使用せずすべてVBAでやってみました。

↓のコードを標準モジュールにコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub シート指定() 'この行から
Dim j As Long, k As Long, endRow As Long, myCol As Long, str As String, myFlg As Boolean

1:
str = InputBox("検索シート名を入力")
With Worksheets(1)
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 4 Then
Range(Cells(5, "A"), Cells(endRow, "AM")).ClearContents
End If
For k = 2 To Worksheets.Count
If Worksheets(k).Name = str Then
myFlg = True
Exit For
End If
Next k
If myFlg = True Then
For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(2, j) <> "" Then
myCol = WorksheetFunction.Match(.Cells(1, j), Worksheets(str).Rows(1), False)
Worksheets(str).Range("A1").AutoFilter field:=myCol, Criteria1:="*" & .Cells(2, j) & "*"
End If
Next j
endRow = Worksheets(str).Cells(Rows.Count, "A").End(xlUp).Row
If Worksheets(str).FilterMode And endRow > 1 Then
Worksheets(str).Rows(2 & ":" & endRow).Copy .Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Worksheets(str).AutoFilterMode = False
Else
If MsgBox("入力したシートが存在しません、再入力しますか？", vbYesNo) = vbYes Then
GoTo 1
Else
Exit Sub
End If
End If
End With
End Sub 'この行まで

※　マクロを実行　→　インプットボックスにSheet名を入力　→　表示
という手順でやっています。

※　すべてのSheetを検索したい場合は少しコードが変わってきます。

こんな感じではどうでしょうか？m(_ _)m

お礼

ありがとうございます。勉強になりました。

補足

昨日に引き続き本当にありがとうございます。
本日は時間があるのでじっくり取り組みたいと思っています。
上記のご指南通りに実行してみた結果無事出来ました。
ありがとうございます。
結果を別シートへ飛ばしたいので検索用Sheetが増えますが、
最初に比べたら恐ろしいくらいの作業効率です。

MackyNo1さんにご紹介頂いた部分も含めて、勉強していきます。ありがとうございました。

回答No.4

tom04

No.3です！
たびたびごめんなさい。

余計なお世話かもしれませんが、No.2さんの補足に
＞sheet2からsheet21のデータを別のsheetに抽出し・・・
とありましたので、また顔を出しました。

Sheet2～最終Sheetの条件に一致するデータをSheet1に表示すると解釈して、
以下のコードを標準モジュールにコピー＆ペーストしてマクロを実行してみてください。

Sub すべてのSheet検索()
Dim j As Long, k As Long, endRow As Long, myCol As Long
With Worksheets(1)
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 4 Then
Range(Cells(5, "A"), Cells(endRow, "AM")).ClearContents
End If
For k = 2 To Worksheets.Count '←Sheet見出しの2番目～最終Sheetまで
For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(2, j) <> "" Then
myCol = WorksheetFunction.Match(.Cells(1, j), Worksheets(k).Rows(1), False)
Worksheets(k).Range("A1").AutoFilter field:=myCol, Criteria1:="*" & .Cells(2, j) & "*"
End If
Next j
endRow = Worksheets(k).Cells(Rows.Count, "A").End(xlUp).Row
If Worksheets(k).FilterMode And endRow > 1 Then
Worksheets(k).Rows(2 & ":" & endRow).Copy .Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Worksheets(k).AutoFilterMode = False
Next k
End With
End Sub 'この行まで

※　今回もSheet1（Sheet見出しの一番左側Sheet）が検索用・表示用のSheetとしています。m(_ _)m

お礼

遅くなりましたが、ありがとうございます。
前回の方法で無事解決しました。

回答No.2

MackyNo1

画像の添付を忘れていましたのでアップします。

なお、添付画像のG1セルが実際はSheet2のA1セルに対応します。

お礼

ありがとうございます。助かりました。

補足

丁寧なご説明で判り易く大変勉強になりました。ありがとうございます。ご紹介頂いたサイトを見ながら別途表を作成してみました。上記画像の左半分をSheet1へ入力し、右半分をSheet2へ入力。下記手順でデータフィルタを使い抽出しました。ところが、抽出は成功したのですが、A列日付が表示されている部分と全くの空白になってる部分が出てきました。また、Sheet1のデータがそのまま表示されます。急いで作業した為、もう一度最初から引き続き成功までやってみます。

希望の操作についてですが、sheet2からsheet21のデータを別のsheetに抽出し、sheet1へ各sheetのデータをVLOOKUP等で纏めたいと思っています。
sheet2から20のサイズはAからAMの範囲になり全く同じものです。
目的は特定条件での傾向を見るために作成したいと考えています。
納品の関係で日々30分程度しかこの作業に時間をかけられなくなりそうな為、力不足と知りながらもご相談させて頂いた次第です。

回答No.1

MackyNo1

目的を含めて、いま一つご希望の操作がわかりにくいのですが、検索条件が増えたり変動する場合に、該当するデータを別シートに抽出したいなら、フィルタオプションの設定の機能を利用することをお勧めします。

すなわち、Sheet2のA1:E1セルにデータベースの項目を入力しておき、その下の行に検索条件を入力しておきます（添付図参照）。

例えば、Sheet1の担当1に「田中」を含み、かつ顧客名に「山田」を含む行をSheet2のA4セル以下に抽出すなら（添付画像右側）、Sheet2のB2セルに「*田中*」、E2セルに「*山田*」と入力しておき、Sheet2を選択しておき、「データ」「フィルタ」（2007以降のバージョンならデータタブの「詳細設定」）「フィルタオプションの設定」で、リスト範囲をSheet1のデータ範囲、検索条件範囲を「A1:E5」にして、抽出先を「指定した範囲」にチェックを入れA4セルを選択してOKします。

上記の操作で担当1に田中を含みかつ顧客名に山田を含むデータがSheet2に抽出することができます。
この操作を自動化したいなら、「新しいマクロの記録」で記録すれば（必要に応じてシート名や検索条件を変更して）自動的に実行することも可能です。

フィルタオプションの詳細については以下のページが参考になると思います。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter3.htm

お礼

ありがとうございます。
参考にさせていただきます。