みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

【Excel2010】リストから部分一致を抽出する

使用OS:Windows7

Excel2010を利用しています。
Sheet1には添付写真のように品目名の下に3000件ー5000件ほどの資材などの名前があります。
Sheet2のA1にある検索したい語句を入れるとSheet1のB列から部分一致する列を抜き出しSheet2のA3以下にその情報が記載されるようにしたいと思っています。

例としてSheet2のA1に『コーススレッド』と入力するとSheet2のA3の行にはSheet1の2行目、A4の行にはSheet1の5行目が記載されるようにしたいです。

オートフィルタや検索を使えばいいじゃないかと言われるかもしれないですが、そういった操作ができない年長の方が使えることを目的としたいので、教えていただけないでしょうか?VBAが絡んでも問題ないです。よろしくお願いします。

投稿日時 - 2012-02-22 10:24:08

QNo.7320051

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

数式入力セル(表示データ数)が多くなると(20件以上該当データがあるような場合)シートの動きが重くなりますので、あまりお勧めできませんが、数式で対応するなら以下のような数式を使うことになります。
例えばSheet2のA3セルにA1セルの文字列を含むB列のデータを抽出するなら以下の式を入力し、下方向にオートフィルコピーします。

=INDEX(Sheet1!B:B,SMALL(INDEX(ISERR(FIND($A$1,Sheet1!$B$2:$B$5000))*10000+ROW($B$2:$B$5000),),ROW(A1)))&""

なお、上記の数式を右方向にオートフィルすれば該当の行のデータを表示できますが、計算負荷を少なくするするには、B3セルから右は以下のようなIF関数で対応するのが良いと思います。

=IF(A3="","",INDEX(Sheet1!C:C,SMALL(INDEX(ISERR(FIND($A$1,Sheet1!$B$2:$B$5000))*10000+ROW($B$2:$B$5000),),ROW(A1))))

投稿日時 - 2012-02-22 13:27:53

ANo.3

抽出部分の消去が面倒くさかったので抽出結果はSheet2のC:E列に出すものとします。
また、Sheet2のA1には「品目名」と入っていて、A2に品目名を手入力するものとします。

コマンドボタンか何かを用意して、手入力後に以下のマクロを動かしてください。

Sub Sample()
  Sheets("Sheet2").Columns("C:E").ClearContents
  Sheets("Sheet1").Range("B:D").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Sheet2").Range("A1:A2"), CopyToRange:=Sheets("Sheet2").Range("C1")
End Sub

投稿日時 - 2012-02-22 13:10:03

ANo.2

分かり易い方法は作業列を作って対応する方法です。
シート1のE2セルには次の式を入力して下方にオートフィルドラッグコピーします。

=IF(COUNTIF(B2,"*"&Sheet2!$A$1&"*"),MAX(E$1:E1)+1,"")

シート2のA1セルには検索したい文字を入力します。
A3セルには次の式を入力したのちに右横方向にオートフィルドラッグコピーしたのちに下方にもオートフィルドラッグコピーします。

=IF(OR(ROW(A1)>MAX(Sheet1!$E:$E),COLUMN(A1)>3),"",INDEX(Sheet1!$B:$D,MATCH(ROW(A1),Sheet1!$E:$E,0),COLUMN(A1)))

投稿日時 - 2012-02-22 12:02:50

ANo.1

>3000件ー5000件ほどの資材などの名前があります。

関数で並べるのは現実的ではない物量なので,マクロを使います。


準備:
シート2の1行目にシート1と同じ項目を並べる
B1,C1,D1に品目名,大分類,大分類番号のように
シート2の2行目に検索ワードを記入することにする

シート2の4行目以下に抽出する


手順:
シート2のシート名タブを右クリックしてコードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

private sub worksheet_change(byval Target as excel.range)
 set target = application.intersect(target, range("2:2"))
 if target is nothing then exit sub

 range("A5:A" & application.max(5, cells.specialcells(xlcelltypelastcell).row)).entirerow.delete shift:=xlshiftup
 if application.counta(target) = 0 then exit sub

 worksheets("Sheet1").range("B:D").advancedfilter _
  action:=xlfiltercopy, _
  criteriarange:=range("B1:D2"), _
  copytorange:=range("B4:D4")
end sub

ファイルメニューから終了してエクセルに戻る
2行目に検索語を記入する。

投稿日時 - 2012-02-22 11:31:07

あなたにオススメの質問