ある重複する文字列を抽出したいのですが・・・

質問

以前似たよな質問をしましたが、少し違うので許してください。
maron--5さんから
　　　A　　　　B　　　　　　C～E　　　　　F　　　　　G　　　　H
1　　番号　　家紋名　　　　　　　　　　　　　　　　　　　　　柏
2　　1　　　いたどり　　　　　　　　　　 該当なし　　　　　　酸漿草
3　　2　　　ひげ丸揚羽蝶　　　　　　　揚羽蝶　　　　　　　桔梗
4　　3　　　ほいのし　　　　　　　　　　 該当なし　　　　　　蛇の目
5　　4　　　むくみ稲妻　　　　　　　　　稲妻　　　　　　　　鷹の羽
6　　5　　　むくみ花菱　　　　　　　　　花菱　　　　　　　　稲妻
7　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　揚羽蝶
8　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　花菱

１）H列を作業列として、ジャンル一覧を入力（別に他のシートでもいい）
２）F2の式
F2=IF(SUMPRODUCT(COUNTIF(B2,"*"&$H$1:$H$8&"*")),LOOKUP(1,0/COUNTIF(B2,"*"&$H$1:$H$8&"*"),$H$1:$H$8),"該当なし")
という式を教えていただきました。

B列に並んでいる文字の中から別の列に並んだジャンル一覧の文字が一致すればその文字をF列に抽出するという式です。

教えてほしいことはジャンルがたくさん並んでいるのですが、そのジャンルが重複した場合のことです。現在F列に抽出されたもじが出てきますが、G列に２つ重複した場合はそのジャンル名が出てくるようにできるでしょうか？たとえば「七宝に花菱」という文字がB列にあって、ジャンルには「七宝」と「花菱」がある場合ということです。そのときにF列に「七宝」G列に「花菱」と出したいのです。
maron--5さんはじめ、わかる方教えてください。

回答No.4

Wendy02 · ベストアンサー

こんにちは。

やっぱり、VBAでしょうね。別の質問の中は、VBAの質問もあるようですから、VBAがお分かりになるという条件で、書きました。

buf(5) は、数を増やせば、もっと入れられます。

'標準モジュール

Function CheckItems(ByVal strText As String, Items As Range, i As Integer)
Dim v As Variant
Dim j As Integer
Dim buf(5) As String '6個の種類が出せる(5+1)
　If strText = "" Then CheckItems = "": Exit Function
　For Each v In Items
　　　v = Replace(v, Space(1), "", , , 1)
　　　If InStr(1, strText, v, 1) > 0 Then
　　　　　buf(j) = v
　　　　　j = j + 1
　　　 End If
　Next v
　If buf(0) = "" Then
　　 buf(0) = "該当なし"
　End If
　　If i <= UBound(buf) Then
　　　　CheckItems = buf(i - 1)
　　Else
　　　　CheckItems = ""
　　End If
End Function

ワークシートの数式は、以下のようになります。

=CheckItems($B2,$H$1:$H$9,COLUMN(A$1))

被検索値, 検索項目範囲,インデックス(1-6　まで）

これを、右にドラックすれば、
=CheckItems($B2,$H$1:$H$9,COLUMN(B$1))

とインデックスが、Bになるので、2が代入されて、２番目の文字が出てきます。

結果

該当なし
揚羽蝶
該当なし
稲妻　　
花菱　　
花菱　　七宝

お礼

ありがとうございました。
この対処方法で解決しました。

回答No.3

imogasi

関数での回答希望はわかりますが、式が長くなるので、ユーザー関数の定義でやってみました。
VBEの標準モジュールに
Function vl(a, b, n)
Dim cl As Range
vl = ""
k = 0
For Each cl In b
p = InStr(a, cl)
If p <> 0 Then
k = k + 1
If k = n Then
vl = cl
Else
End If
Else
End If
Next
End Function
を貼り付ける。
ーー
例データ
B16:B24
aabb
cc
aacc
cc
bb
ccaa
bbaa
xxbb
xxbbaa
E１６：E18にジャンルのリスト
aa
bb
xx
F16に
=vl($B16,$E$16:$E$18,COLUMN()-5)
（=VL(注目セルジャンル表範囲,何番目)の意味です。
F列から右列に出すので、COLUMN()-5が何番目を表せる。）
と入れてF24まで式複写する。
F18:F24までの式をI18:I24まで式を複写する。
結果
F18:I24（４列、最大でジャンル４個まで出すので）
aa bb

aa

bb
aa
aa bb
bb xx
aa bb xx
最大５までならJ列まで式を複写。

回答No.2

Nouble

かなり力業ですが
=IF(SUMPRODUCT(1-ISERR(FIND(INDIRECT("$H$1:$H$"&COUNTA(H:H)),B2))),,"該当なし")&IF(ISERR(FIND($H$1,B2)),"",$H$1)&IF(ISERR(FIND($H$2,B2)),"",$H$2)&IF(ISERR(FIND($H$3,B2)),"",$H$3)&IF(ISERR(FIND($H$4,B2)),"",$H$4)&IF(ISERR(FIND($H$5,B2)),"",$H$5)&IF(ISERR(FIND($H$6,B2)),"",$H$6)&IF(ISERR(FIND($H$7,B2)),"",$H$7)&IF(ISERR(FIND($H$8,B2)),"",$H$8)

例えば
{"柏";"";"桔梗";"";"";"";"揚羽蝶";""}
と言ったような
文字列の配列数式の各要素を
「柏桔梗揚羽蝶」と言う風に繋ぎたいとするとき

今回の上記のような力業でなく
エレガントな方法でつなぐやり方は
残念ながら私の知る限りでは
まだ発表されていないと思います。

昨年年始に私もトライしたのですが
かなりな難問ですね。

回答No.1

maron--5

A 　　　　B　　　　　　C　D　E　　　　　F　　　　　　　G　　　　　H　　　　　　　I
1　　番号　　家紋名　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　柏
2　　1　　　　いたどり　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　酸漿草
3　　2　　　　ひげ丸揚羽蝶　　　　　　　 揚羽蝶　　　　　　　　　　　　　　　　　　桔梗
4　　3　　　　ほいのし　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　蛇の目
5　　4　　　　むくみ稲妻　　　　　　　　　 稲妻　　　　　　　　　　　　　　　　　　　七宝
6　　5　　　　稲妻花菱と蛇の目　　　　　蛇の目　　　　稲妻　　　花菱　　　　　稲妻
7　　6　　　　七宝に花菱　　　　　　　　　七宝　　　　　　花菱　　　　　　　　　　　揚羽蝶
8　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　花菱

F2=IF(COLUMN(A1)>SUMPRODUCT(COUNTIF($B2,"*"&$I$1:$I$8&"*")),"",INDEX($I$1:$I$8,SMALL(INDEX(SUBSTITUTE(COUNTIF($B2,"*"&$I$1:$I$8&"*")*1,0,10^5)*ROW($I$1:$I$8),),COLUMN(A1))))

★右にH2までと下にコピー
★3種類まで可能です、もっと右までコピーすれば何種類でも可能です
★ただし、「該当なし」は表示されません

お礼

ありがとうございました。関数での対処ではこの方法が私にはわかりやすかったです。勉強になりました。