- ベストアンサー
エクセルで検索し別シートに抽出したい方法とは？
- エクセルで検索し、別シートに抽出する方法について教えてください。
- Sheet1にある項目をSheet2に抽出したい場合、どのような方法が効果的ですか？
- Sheet2での検索項目の追加方法についても教えてください。
- passionfruit
- お礼率75% (9/12)
- オフィス系ソフト
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
こんばんは！ ＞Sheet1のAからAMにそれぞれ各項目があり・・・ とありますので、作業用の列はAN列以降にしなければならないと思います。 尚、 ＞後々検索したい項目が増えた時に追加しやすい方法だと助かります に関してはかなり厄介ですね！ 検索列が決まっていなければ作業列の数式も相当長い数式になってしまうのではないでしょうか？ その数式を考える気力がありませんので、作業列に関してはVBAでやってみました。 Sheet1・Sheet2の配置は画像通りだとし、作業列はSheet1のAN列にするようにしてみました。 以下の通りにやってみてください。 まずAlt＋F11キー → メニュー → 挿入 → 標準モジュール → VBE画面に ↓のコードをコピー＆ペーストしておいてください。 Sub 作業列表示() 'この行から Dim i As Long, j As Long, k As Long, endRow As Long, c As Range, wS As Worksheet, myFlg As Boolean Set wS = Worksheets("Sheet2") Application.ScreenUpdating = False With Worksheets("Sheet1") On Error Resume Next '←お・ま・し・な・い（クリステルさん風） endRow = .Cells(Rows.Count, "AN").End(xlUp).Row If endRow > 1 Then Range(.Cells(2, "AN"), .Cells(endRow, "AN")).ClearContents End If If WorksheetFunction.CountA(wS.Rows(2)) > 0 Then For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row For j = 1 To wS.Cells(1, Columns.Count).End(xlToLeft).Column If wS.Cells(2, j) <> "" Then k = WorksheetFunction.Match(wS.Cells(1, j), .Rows(1), False) If InStr(.Cells(i, k), wS.Cells(2, j)) = 0 Then myFlg = True Exit For End If End If Next j If myFlg = False Then .Cells(i, "AN") = i End If myFlg = False Next i End If End With Application.ScreenUpdating = True End Sub 'この行まで 次に画面左下のSheet2のSheet見出し上で右クリック → コードの表示 → VBE画面に ↓のコードをコピー＆ペースト Private Sub Worksheet_Change(ByVal Target As Range) 'この行から If Application.Intersect(Target, Rows(2)) Is Nothing Or Target.Count <> 1 Then Exit Sub Call 作業列表示 End Sub 'この行まで 以上の準備ができた上で、Sheet2の2行目に検索したいデータを入力してみてください。 Sheet2の1行目項目名はSheet1と同じ項目名にしておきます。←必須です！（注）※ これでSheet1のAN列にSheet2の2行目のデータが含まれるものの行番号が表示されますので、 最後にSheet2のA5セルに =IF(COUNT(Sheet1!$AN:$AN)<ROW(A1),"",INDEX(Sheet1!A:A,SMALL(Sheet1!$AN:$AN,ROW(A1)))) という数式を入れ、列・行方向にオートフィルでコピー！ これで何とかご希望に近い形にならないでしょうか？m(_ _)m
お礼
無事思うように反映出来ました。 ここ数日悩みの種だったので本当に助かりました。 ありがとうございます。 全部を理解するには、まだ大分知識が足りないように感じましたが、当分このシートを使う予定なので知識の補填をしていきたいと思います。 ありがとうございました。