複数条件での抽出

質問

A1行に、
（タイトル）
　RINGO
　MIKAN
　NASHI
　BUDOU
　TOMATO
　みかん
　momo
　AMAIぶどう
　MOMO
　　・
　　・
　　・

と、リストタイトルつきで単語がずらっと入っています。(全部で50種類くらいです)
この中から、5種類の条件（RINGO、MIKANN、TOMATO、MOMO、全角文字が含まれるもの）を現在のsheet1に抽出したいです。
マクロでも関数でもいいので、知恵がある方、教えてください。
お願いします。

回答No.7

merlionXX · ベストアンサー

No6です。

さきほど回答したマクロに一部不備がありました。
RINGO、MIKANN、TOMATO、MOMO　はただの例で実際はちがうんでしょう？
この例では問題が出ませんが、もし例示のRINGO、MIKANN、TOMATO、MOMOの中に一つでも全角文字があったら、「全角文字が含まれるもの」とのチェックにもひっかかり二重に検索されてしまいます。
訂正します。

Sub test01()
Dim myAr As Variant
Dim buf As Boolean
myAr = Split("RINGO、MIKANN、TOMATO、MOMO", "、") '検索文字を配列に格納
For Each c In Range("A1:A100") '検索範囲の各セルにつき
If c.Value <> "" Then '空白でなければ
For i = 0 To UBound(myAr)
buf = False
If c.Value = myAr(i) Then '配列のどれかに一致すれば
n = n + 1 'カウント
Cells(n, "D") = c.Value 'D列に転記
buf = True '配列一致フラグ
Exit For 'For-Nextを抜ける
End If
Next i '配列最後まで繰り返し
If buf = False Then '配列と一致しなければ
If LenB(StrConv(c.Value, vbFromUnicode)) > Len(c.Value) Then '全角文字があれば
n = n + 1 'カウント
Cells(n, "D") = c.Value 'D列に転記
End If
End If
End If
Next c '範囲最後まで繰り返し
End Sub

回答No.6

merlionXX

まだマクロの例が出てないようなので一例を
A1:A100を対象範囲としてますが足りなければ適当に増やしてください。
転記先を同じシートのD1以降にしてますが都合が悪ければなおしてください。

Sub test01()
Dim myAr
myAr = Split("RINGO、MIKANN、TOMATO、MOMO", "、") '検索文字を配列に格納
For Each c In Range("A1:A100") '検索範囲の各セルにつき
If c.Value <> "" Then '空白でなければ
For i = 0 To UBound(myAr)
If c.Value = myAr(i) Then '配列のどれかに一致すれば
n = n + 1 'カウント
Cells(n, "D") = c.Value 'D列に転記
Exit For 'For-Nextを抜ける
End If
Next i '配列最後まで繰り返し
If LenB(StrConv(c.Value, vbFromUnicode)) > Len(c.Value) Then '全角文字があれば
n = n + 1 'カウント
Cells(n, "D") = c.Value 'D列に転記
End If
End If
Next c '範囲最後まで繰り返し
End Sub

回答No.5

hallo-2007

Sheet2のA列に
（タイトル）
　RINGO
　MIKAN
　NASHI
　BUDOU
　TOMATO
　みかん
・・・と入っている
Sheet3のA列に
抽出文字
RINGO
MIKANN
TOMATO
MOMO
・・・と50行に入れる。
Sheet2のB列に
=IF(SUM(COUNTIF(A2,"*"&(Sheet3!A$1:A$50)&"*")),ROW(),"")
といれてCtrl+Shift+Enterで決定します。下へコピィします。
条件にあっていれば、その行番号を表示させます。
Sheet1のA列に
=IF(ISERROR(SMALL(Sheet2!B:B,ROW(A1))),"",INDEX(Sheet2!A:A,SMALL(Sheet2!B:B,ROW(A1))))
といれて下へコピィしてください。

回答No.4

mu2011

NO3です。
数式の設定条件を失念していましたので追記します。
（２）は配列数式の為、入力完了時にshift＋ctrl＋enterキーを同時押下して下さい。

回答No.3

mu2011

次の方法は如何でしょうか。
（１）リストシートのB2に=SUMPRODUCT(ISNUMBER(FIND(A2,{"RINGO","MIKAN","TOMATO","MOMO"}))*1)+SUMPRODUCT((LEN(A2)<>LENB(A2))*1)を設定、下方向にコピー
（２）sheet1の任意セルに=IF(COUNTIF($B$2:$B$100,">0")>ROW(A1)-1,INDEX(リスト!A:A,SMALL(IF(リスト!$B$2:$B$100>0,ROW(リスト!$A$2:$A$100),9999),ROW(A1))),"")を設定、下方向にコピー

回答No.2

gyouda1114

タイトルをA列　抽出語句をD列に　E列に〇

B2セルに　=IF(ISERROR(VLOOKUP(A2,$D$1:$E$5,2,0)),"",VLOOKUP(A2,$D$1:$E$5,2,0))
下方におーとふぃる

画像を参考にどうぞ

回答No.1

tossy_tnwk

Ａ１行と質問にありますが
Ａ列と解釈して回答します。
別のシート（仮にsheet2とする）のＡ列に抽出したい文字を１行目から記述します。sheet2のＢ列に"HIT"とか分かりやすい文字を入れておきます。
sheet1に戻ってＢ列にＶＬＯＯＫ関数を使って
=VLOOKUP(A1,Sheet2!A:B,2,FALSE)
と入力し、データの入っている最後の行までコピーする。
あとはフィルタ機能でsheet2のＢ列に記述した文字
この場合は"HIT"を選択すればＯＫッス