excelで文字列の部分一致の抽出について

質問

excel初心者です。excelの文字列中の一部が、決まった検索ワード(複数、別シートに一覧になっている）と一致する場合に、その検索ワードに対応する数字がふられるようにする数式を教えてください。countifやvookupでやってみましたが、検索ワードが複数なのでワイルドカード＊が使えず、挫折しました。
sheet1が基データで、sheet2が検索ワードとそれに対応する数字のリストです。sheet1のＢ列に検索ワードの対応数字を入れたいです。sheet1のB列にどんな数式を入れたらいいのでしょうか。
sheet2の検索ワードの範囲はA1～B65です。

*追伸：サンプルの各シートのＡ列とＢ列の間にスペースを入れたつもりですが、質問文では削除？されて、くっついた表示になっています。見づらくてすみませんが、数字はＢ列だと思ってください。もうしわけありません。

サンプル：

sheet1
（Ａ列）
山口理事長
佐藤名誉会長
小林事業本部長
高橋代表取締役社長
高田課長
山本専務理事

sheet2
（A列） （Ｂ列）
社長 1
会長 1
代表取締役 1
理事 2
本部長 2
専務 3
（以下５０個ほど続きます。Ｂ列の数字は重複します）

↓以下のようにしたいです

sheet1
（Ａ列） （Ｂ列）
山口理事長 2
佐藤名誉会長 1
小林事業本部長 2
高橋代表取締役社長 1,1
高田課長
山本専務理事 3,2

アドバイスの程、何卒よろしくお願いします。

回答No.2

KURUMITO · ベストアンサー

複雑な関数を使ってもマクロを使用してもシート2の項目が多くなりますと計算速度も遅くなります。
作業列を使って対応することが最も簡単で計算にも負担のかからない方法です。
シート1ではA3セルから下方にお示しのデータが入力されているとします。
またシート2でがA1セルから下方にっく伯セルが無い状態で下方にお示しのデータが、また、B1セルから下方にお示しの数値が入力されているとします。
これらのデータをシート1のD1セルから右横に社長などの文字を、D2セルから右側に点数を表示させることにします。
そのためにD１セルには次の式を入力してD2セルまでドラッグコピーしたのちに右横方向にドラッグコピーします。

=IF(INDEX(Sheet2!$A:$A,COLUMN(A2))="","",IF(ROW(A2)=1,INDEX(Sheet2!$A:$A,COLUMN(A2)),IF(ROW(A2)=2,INDEX(Sheet2!$B:$B,COLUMN(A2)),"")))

D3セルには次の式を入力したのちに右横方向にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(OR($A3="",D$1=""),"",IF(COUNTIF($A3,"*"&D$1&"*"),C3&","&D$2,C3))

その後にB3セルには次の式を入力して下方にドラッグコピーします。

=MID(SUBSTITUTE(INDEX(D3:XX3,COUNTIF(D$1:XX$1,"?*")),"0",""),2,3)

これでお望みのデータがB列に表示されます。
作業列が目障りでしたらそれらの列を選択して右クリックし「非表示」を選択すればよいでしょう。
なお、山田専務理事は2，3と表示されますがシート2での並びを専務が理事よりも上になるように並び替えることで3，2のように表示させることができます。

お礼

お礼が大変遅くなり申し訳ありません。

何度も試してみましたが、知識が少なくうまくいきませんでした・・
そのうち仕事でこの作業が不要になってしまいました。

でもすぐにこんな複雑で丁寧な回答をいただき、感謝しています。
どうもありがとうございました。

回答No.1

tom04

こんにちは！
VBAになってしまいますが、一例です。

Alt＋F11キー　→　メニュー　→　挿入　→　「標準モジュール」を選択　→　VBE画面に
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）
尚、両Sheetともデータは1行目からあるとします。

Sub Sample1() 'この行から
Dim i As Long, k As Long, buf As String, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS1.Columns(2).ClearContents
For i = 1 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To wS2.Cells(Rows.Count, 1).End(xlUp).Row
If InStr(wS1.Cells(i, 1), wS2.Cells(k, 1)) > 1 Then
buf = buf & wS2.Cells(k, 2) & ","
End If
Next k
If Len(buf) > 1 Then
wS1.Cells(i, 2) = Left(buf, Len(buf) - 1)
buf = ""
End If
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

※　＞山本専務理事 が　3,2
ではなく
2.3　という表示になってしまいますが・・・

こんな感じではどうでしょうか？m（_ _）m

お礼

お礼が大変遅くなり申し訳ありません。

ＶＢＡの知識がなく、まったくわかりませんでした・・
そのうち仕事でこの作業が不要になってしまいました。

でもすぐにこんな複雑で丁寧な回答をいただき、感謝しています。
どうもありがとうございました。