関数 該当品の抜き出し

質問

Ａ列に型式が何十行も入力されています。例　AB0123HO
別シート（Ｂ）には、Ａ列の型式にスペースが　
入った型式が複数入力されています　　　　　例　AB 0352HO
ＢにＡの型式と全く同じものでもなくても、Ａを含めば、
Ａ列のシートにＢシートの型式を表示したい。

Ａ列の型式　　　　　Ｂシート
A1　AB0123HO　　　　AC 0237AO
A2　AB0245EO AC 1245RO
A3　AC0341E1 AV 2140TO

ご伝授ください

回答No.2

kuma3f · ベストアンサー

思われていることと違っていましたらすみませんが、参考までに次のコードをマクロに貼り付けて実行してみてください。
元を壊してはいけないので、Ｂｏｏｋをコピーして試してみてください。
下記のコードの（１）にＡ列のシートのシート名に、（２）にＢシートのシート名に、（３）にＢシートの型式を表示したい列（Ｂ列なら２）にしてください。（合っていたらそのままでよいです。）

メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。（例：抽出）
　↓
名前を入力しましたら、「作成」をクリック
　↓
Microsoft Visual Basicの画面が開きますのでSub 抽出()の下に次のコードをコピーして貼り付けてください。

'定義
Dim 検索文字, シート名1, シート名2, HIT文字 As String
Dim 縦カウント, 最初のHIT行, HIT行, HIT列, 表示列 As Long
シート名1 = "Sheet1" '←Ａ列のシートのシート名をセット（１）
シート名2 = "Sheet2" '←Ｂシートのシート名をセット…（２）
表示列 = 2 '←Ａ列のシートにＢシートの型式を表示したい列をセット（Ｂ列なら2）…（３）
'Ｂ列のクリア
Sheets(シート名1).Columns(表示列).Select
Selection.ClearContents
Sheets(シート名1).Range("A1").Select

検索文字 = InputBox("検索文字を入力してください。", "検索") '検索文字列
縦カウント = 1
'最初のHIT
Sheets(シート名2).Select
Sheets(シート名2).Range("A65536").Select
On Error GoTo exit00
Sheets(シート名2).Cells.Find(What:=検索文字, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False).Activate
最初のHIT行 = ActiveCell.Row '最初にHITした行
HIT列 = ActiveCell.Column '最初にHITした列
HIT文字 = Sheets(シート名2).Cells(最初のHIT行, HIT列)
Sheets(シート名1).Select
Sheets(シート名1).Cells(縦カウント, 表示列) = HIT文字
縦カウント = 縦カウント + 1
'２件目以降のHIT
Do
Sheets(シート名2).Select
Sheets(シート名2).Cells.Find(What:=検索文字, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False).Activate
HIT行 = ActiveCell.Row 'HITした行
HIT列 = ActiveCell.Column 'HITした列
If HIT行 <> 最初のHIT行 Then
HIT文字 = Sheets(シート名2).Cells(HIT行, HIT列)
Sheets(シート名1).Select
Sheets(シート名1).Cells(縦カウント, 表示列) = HIT文字
End If
縦カウント = 縦カウント + 1
Loop Until HIT行 = 最初のHIT行
Sheets(シート名1).Select
Sheets(シート名1).Range("A1").Select
MsgBox "抽出しました。　"
Exit Sub
exit00:
Sheets(シート名1).Select
Sheets(シート名1).Range("A1").Select
MsgBox "検索した文字列がありません。"
Exit Sub
'****コピー貼り付けはここまで ****

Microsoft Visual Basicの画面を×で閉じます
　↓
Excel画面のメニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
先ほど名前を付けたマクロを選択して「実行」をクリック

回答No.1

mu2011

安直ですが、次の方法は駄目でしょうか。
（１）別Ｂシートの型式列に見出し行を挿入→フィルタ→オートフィルタ→見出し行のダウンリストでオプションを選択→「A」、「含む」を選択→ＯＫ
（２）抽出された範囲をコピー＆ペースト

補足

型式がありすぎまして、その方法だと何時間かかっとるんじゃと
言われ兼ねません。
他の方法は、無いでしょうか？