1578995879 Excelでキーワードに対応するSheet内を全文検索して結果の行のみを抽出したい


今、A列とD列に以下のような文字列が入力されております。
A列にはキーワード、D列には実際にExcel内にあるシート名が入っております。
Sheet1、Sheet2、Sheet3…には、各シート3000行ぐらいデータが入っており、全部で30、Sheet30ぐらいまであります。

この状況におきまして。

A列のセルのキーワードを、D列のセル内で指定しているシートで検索し、一致する行だけを、シート内で表示させたいのです。
例えば2行目の場合、A列は"りんご"とあります。そしてD列は"Sheet1"と記載があります。
ですので、Sheet1内にある3000行ほどのデータを対象に、"りんご"が含まれているデータがないかを検索し、ヒットしたらSheet1内で「キーワードが含まれる(部分一致する)行だけを表示する」("りんご"が含まれない行は非表示か削除で構いません)という処理を行いたいのです。

最初は、A列の文字列を、D列で指定しているシート内で検索し、ヒットした行を抽出していたのですが…A列のデータも700行(個)ぐらいありまして、とても手作業でやるのに厳しさを覚えまして…お力添えをいただけますと幸いです。
よろしくお願い致します。

回答の条件
  • 1人10回まで
  • 登録:
  • 終了:2020/01/16 18:00:49

ベストアンサー

id:a-kuma3 No.1

回答回数4959ベストアンサー獲得回数2146

ポイント1500pt

下記のマクロを標準モジュールにはりつけて、「A列検索」のシートが選択されている状態で filter_all サブルーチンを実行してください。

Function is_sheet_exists(sheet_name)
    Dim s As Excel.Worksheet
    On Error Resume Next
    Set s = Sheets(sheet_name)
    On Error GoTo 0
    is_sheet_exists = Not s Is Nothing
End Function

Sub filter_by_keyword(sheet_name, keyword)
    Set Sheet = Sheets(sheet_name)
    If Sheet.AutoFilterMode Then
        Sheet.Cells.AutoFilter
    End If
    Sheet.Cells.AutoFilter Field:=1, Criteria1:="=*" & keyword & "*", Operator:=xlAnd
End Sub

Sub filter_all()
    last_row = Cells(Rows.Count, 1).End(xlUp).Row
    For r = 2 To last_row
        sheet_name = Cells(r, 4).Value
        keyword = Cells(r, 1).Value
        If is_sheet_exists(sheet_name) Then
            Call filter_by_keyword(sheet_name, keyword)
        Else
            ' シートがなければ、E列にメッセージ
            Cells(r, 5).Value = "×シートなし"
        End If
    Next
End Sub

フィルターの機能を使って、キーワードが含まれる行だけを表示するようにしています。
キーワードを探す他のシートについて、以下のことを前提としています。
・一行目はタイトル行(検索の対象外)
・キーワードを探す対象は A列


先のマクロを実行すると、「A列検索」以外のシート全てにフィルターがかかった状態になります。
必要ないかもしれませんが、フィルターを一括でリセットするマクロもつけておきます。

Sub reset_filter()
    For Each s In Sheets
        If s.AutoFilterMode Then
            s.Cells.AutoFilter
        End If
    Next
End Sub


----
追記です。

先のコードに、シートの存在チェックを追加しました。
もし「A列検索」の D列のシート名に相当するシートが無い場合には、MsgBox を表示します。
たくさん間違ってると、ちょっとうっとおしい感じなので、シートの別の列に結果を記載する方が良いのかもしれません。


----
更に追記です。
存在しないシートが多いということなので、MsgBox ではなく「A列検索」のシート名の隣 E列のセルに、シートがなかった場合には「×シートなし」と入れるようにしました。
E列が既に使われているようでしたら、以下の「5」を適当に変えてください。

        Else
            ' シートがなければ、E列にメッセージ
            Cells(r, 5).Value = "×シートなし"
        End If
他3件のコメントを見る
id:a-kuma3

回答のコードを少し変えました。
シートがなかったときには、シート名の隣の E列のセルに「×シートなし」と入れるようにしています。

2020/01/15 21:25:04
id:moon-fondu

うまくいきました!ありがとうございます(^^;)

2020/01/16 18:00:16

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません