エクセル、VBA、抽出複数検索について

質問

エクセル、VBA、VLOOKUP、MATCH関数等について出来る方法があれば教えてください。

インチごとに分けてあるシートがあり、（在庫表です）
これを参照して、別ブックへVLOOKUP等を使って、サンプルデータのシート4のように表示させたいのですが、
何か方法を使って出来ることは可能でしょうか？

問題点が複数あります
1、VLOOKUPの範囲について、B列が結合されていて、C列は複数行あるため、商品名が入ってきません。

C列については、何千件とデータがあるため、結合することは不可能です。

一致している条件としては商品コードが必ずあり、商品名には「/」が入っております。

=CONCATENATEとVLOOKUPは一緒に使うことは可能ですか？

もしくはINDEX関数やIF、SUMPRODUCT等を使うのでしょうか？

シート4のような形に出来る方法があれば、教えてほしいです。

VBAは詳しくはないのですが、VBAで出来るのであれば、教えてほしいです。

在庫表はとても作り方が悪いのですが、これを作り直すと言うことは、不可能です。

グループ会社で使っているため、なんとかこの在庫表を使いたいです。

VBAでA列をA5からA100にコードのみ入れた場合、B列に商品名が入るようにVBAで作ることは可能でしょうか？

もしくは、検索条件を2つ使って、一つは商品コード完全一致+あいまい検索で【/】で商品名を入れることは可能でしょうか？

関数は調べたのですが、関数では難しいのかなと思います。

宜しくお願い致します。

回答No.2

eden3616 · ベストアンサー

■想定される以下の条件で利用できるように作りました。
(1)取得元のシートはA列：商品コード、B列：商品名、C列：在庫数にしてください。
(2)シート数はどれだけあっても構いません。
(3)「商品マスタ」シートを含めすべてのシート名は自由に変えれます。
(4)出力先シートに商品コードを入力する際、コピー貼付（複数可）にも対応しています。
（１つのセルを選択後、コピーして飛び地のセルを複数選択貼付には対応していません）
(5)出力先のシートで入力する商品コードの数（行数）に制限はありません。
（１行目は項目名が入っているため2行目以降にデータを入力してください）

■設置方法
(1)出力先のシート（サンプルで「sheet4」となっているシート）名を右クリック
(2)「コードの表示」を選択
(3)Microsoft Visual Basicが開きます
(4)以下のVBAソースに書かれているプログラムを張り付けてください（添付画像参考）

■利用方法
(1)出力先のシートのA列2行目以降にデータを入力してください。
(2)マクロが実行されて出力先のシートのC～E列に入力されます
(3)入力したデータを削除（Delete）すればC～E列の値も削除されます

■VBAソース
Private Sub Worksheet_Change(ByVal Target As Range)
Dim trow As Integer, i As Long
Dim cnt As Integer, hit As Integer
If Target.Column <> 1 Then Exit Sub
If Target.Row < 2 Then Exit Sub
If Selection(Selection.Count).Column > 1 Then Exit Sub
Target.Select
For j = 1 To Selection.Count
trow = Selection(j).Row
If Selection(j).Value <> "" Then
For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
With Sheets(i)
hit = srh(Selection(j).Value, .Range("A:A"))
If hit <> 0 Then
cnt = hit
Do Until .Range("B" & cnt) <> "" And .Range("B" & cnt) <> "売り切り"
cnt = cnt + 1
Loop
End If
End With
End If
If hit > 0 Then Exit For
Next i
With ActiveSheet
.Range("C" & trow) = Sheets(i).Range("A" & hit).Text
.Range("D" & trow) = Sheets(i).Range("B" & cnt).Text
.Range("E" & trow) = Sheets(i).Range("C" & hit).Text
End With
Else
With ActiveSheet
.Range("C" & trow) = ""
.Range("D" & trow) = ""
.Range("E" & trow) = ""
End With
End If
Next j
End Sub

Function srh(word As String, tar As Range) As Integer
On Error GoTo era
srh = WorksheetFunction.Match(word, tar, 0)
Exit Function
era:
srh = 0
End Function

■最後に
必ずチェックしてください。
不具合あれば直します。

補足

ありがとうございます！！すごいです。そんなことが出来るのですね。。

まずは1シート試してみましたが、商品名の一列目に売り切りと入っている場合、きちんと商品名が出ているのですが、その他にも文字列が入っている場合があるのですが、コードの中にどこを追加すれば、売り切りのように対応出来るのでしょうか？

回答No.6

eden3616

>ほぼほぼうまくいってるのですが、B列の商品名部分に、一つのコードに対し、7行ある商品があるのですが、一つだけ一番下のmade in **が入っている部分があるのですが、なぜでしょうか？

該当箇所の元データを見れば原因が分かると思いますが。
勝手に想定してみます。

(1)商品コードを入力
(2)(1)で入力された商品コードを各シートのA列より検索
(3)B列の(2)と同じ行または飛ばした行から下方向へ空白以外のセルを探す
(4)(3)で見つかったセルを商品名として取得
(5)C列の(2)と同じ行の値を在庫として取得

上記流れで処理をしております。
（セルが結合されている場合VBAでは結合されている一番上のセルが値の入力されたセルとして認識されます）
よって(1)で1行読み飛ばした修正（cnt = hit + 1の修正）をしたものとしますと、
商品コードと同じ行に商品名が入力されており、かつグループ（7行以内）のB列の最終行「MADE IN ～」までに何も文字が入力されていない場合
最終行の「MADE IN ～」を商品名として取得してしまいます。

この状態が回答No4での以下の文面になります
――――――――――――――――――――
ただし、その「何か」が入っている行と、製品名が入っている行が混同する場合や
商品名が何も入っていない場合が存在する場合は
質問者様の「/」が含まれているかどうか等の条件で調べてそれが商品名なのかどうか判断する必要があります。
――――――――――――――――――――

上記状態ではない場合は、該当部分の抽出元データをご提示お願いします。

補足

あまり理解していなくて、申し訳ございませんでした。

一行目空白で二行目に売り切りと入っていたため、一行目が空白だったのが原因だったようで、全て商品名が入っていなかった分は、一行目に全部文字列を入れたら、解決しました！！

ありがとうございました！！

まだやりたいことがあって、調べたりしているのですが、また出来るのか質問させて頂く予定ですので、もし分かる範囲であれば、教えてほしいです。

本当にご親切にありがとうございました！！！

回答No.5

eden3616

申し訳ありません。
No2の修正内容に間違いがあります。

cnt = hit + 1
Do Until .Range("B" & cnt) <> "" And .Range("A" & cnt) = "" and cnt < 100

とせずに、

cnt = hit + 1
Do Until .Range("B" & cnt) <> "" Or .Range("A" & cnt) <> ""

としてください。

※補足
プログラムを簡単にするために以下は問題ないかな？と想定してエラー対策の処理を加えておりません。
扱う行数（商品コードを検索して見つかった行数や、sheet4で入力される行数等）が30000行を超えるような
膨大なデータであればオーバーフローのエラーが発生します。

補足

遅くなり申し訳ございません。

すばらしすぎて感動しております。本当にありがとうございます。

ほぼほぼうまくいってるのですが、B列の商品名部分に、一つのコードに対し、7行ある商品があるのですが、一つだけ一番下のmade in **が入っている部分があるのですが、なぜでしょうか？

数個でしたら、手で打ち込んでも良いのですが、原因が分かるのであれば教えてほしいのですが、ほぼ完ぺきに名前が入りました！！！！

回答No.4

eden3616

>その他にも文字列が入っている場合があるのですが、

商品コードと同じ行のB列のセルに「何か（商品名以外）」が入っている可能性があるのであれば

～省略～

cnt = hit
Do Until .Range("B" & cnt) <> "" And .Range("B" & cnt) <> "売り切り"

～省略～

の部分で以下のようにしてください。

cnt = hit + 1
Do Until .Range("B" & cnt) <> "" And .Range("A" & cnt) = "" and cnt < 100

商品コードと同じ行を読み飛ばしてB列の次の行から何か入力されているセルまでを調べるようになります。
もし次の行にも何か別の物の入っている場合は上記修正部分で

cnt = hit + 2

としてください。（2行分を読み飛ばします）
ただし、その「何か」が入っている行と、製品名が入っている行が混同する場合や
商品名が何も入っていない場合が存在する場合は
質問者様の「/」が含まれているかどうか等の条件で調べてそれが商品名なのかどうか判断する必要があります。

★追加で以下を修正願います★
申し訳ありません。
存在しない商品コードを入力した場合「インデックスが有効範囲内にない」のエラーがでますので、

～省略～

With ActiveSheet
.Range("C" & trow) = Sheets(i).Range("A" & hit).Text
.Range("D" & trow) = Sheets(i).Range("B" & cnt).Text
.Range("E" & trow) = Sheets(i).Range("C" & hit).Text
End With

～省略～

の部分を

If hit = 0 Then
MsgBox "入力されたコード""" & Selection(j).Value & """が見つかりませんでした"
Else
With ActiveSheet
.Range("C" & trow) = Sheets(i).Range("A" & hit).Text
.Range("D" & trow) = Sheets(i).Range("B" & cnt).Text
.Range("E" & trow) = Sheets(i).Range("C" & hit).Text
End With
End If

としてください。
見つからなかった場合にダイアログが表示されるようになります。

お礼

本当にありがとうございます！！！

回答No.3

eden3616

No2で添付画像を付け忘れていました。

お礼

今までずっとできなくて、知恵袋でも不可能だと言われていたので、本当に出会えてよかったです！！

回答No.1

eden3616

マクロでつくろうにも確認点がいくつかありますが。

取得元と思われるシートが「ribon」、「12インチ-13インチ 」と２シートありますが複数シートですか？
上記２つのシートは列のフォーマットが異なるようですが統一されてないということですか？
取得元のシート名は統一されてませんか？
「Sheet4」のシート名は変動しますか？
「Sheet4」の入力行の範囲（サンプルで2～9行）は変動しますか？

補足

複数シートとなります。全部で8シートです。

列は統一することは可能です。A列商品コード、B列商品名、C列在庫数にすることは可能です。

取得元のシート名はインチごとに異なるため、統一されておりません。

02タイヤ リボン・レター、02タイヤ 12インチ-14インチ 、02タイヤ 15インチ、02タイヤ スタッドレス

このようなシート名で、02タイヤだけは統一されております。

シート4のシート名は商品マスタとするつもりです。

入力行の範囲はA1を見出しとして、
A2から商品があるだけ行は追加されていきます。

出来ますでしょうか？？＞＜