vlookup＆部分一致の文字列のループについて教えて下さい！

初めて質問させて頂きます、VBAの初心者向け本を3冊くらい勉強し、簡単なマクロは調べ調べ、見よう見まねで書き、多少の業務効率化はできるようになったけれど、配列などが出てくると理解すらできない・・というレベルの初心者です。
詳しい方なら瞬時におわかりになると思うのですが、もう1時間以上悩んでおります。

【やりたいこと】
添付画像で、左側の利用店舗に部分一致するものを右のリストから探して、vlookup的な感じで利用緒店舗の隣のセルに科目名を入れたい、というものです。

【悩んでいること】
自分なりに調べて、Instr、Index、Match、Filter、Find（←遅いとありました）等の関数やメソッドが関係しているようだ・・とわかったのですが、部分一致でつまづき、ループの中にループを入れる形でいいのか、配列等を使ったらすっきり高速な処理ができるのだろうか・・と思いつつ、頭がこんがらがってきてお手上げの状態です。

ヒントになるコードをご教示頂けたら、できるだけ調べ、理解するよう努めたいと思います。何卒よろしくお願い致します。

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/09/23 11:10

No1です。

以下のマクロを標準モジュールに登録してください。
利用店舗のシート名が提示されていないので、"利用店舗"としました。（変数名はws2）、シート名が異なる場合は、適宜修正してください。

リストのシート名が提示されていないので、"リスト"としました。（変数名はws1）、シート名が異なる場合は、適宜修正してください。

利用店舗の行数は806行が現行の範囲ですが、行が追加された場合を考慮して、806の値は採用しません。行が増えても、自動的に対応するようにしています。(最大行を求めてmaxrow2に格納)

リストの最大行数も同様です。
---------------------------------------
Option Explicit


Public Sub 科目設定()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim str1 As String
Dim str2 As String
Set ws1 = Worksheets("リスト")
Set ws2 = Worksheets("利用店舗")
maxrow1 = ws1.Cells(Rows.count, "G").End(xlUp).Row 'リストの最大行取得
maxrow2 = ws2.Cells(Rows.count, "E").End(xlUp).Row '利用店舗の最大行取得
ws2.Range("F7:F" & maxrow2).ClearContents '科目クリア
For row2 = 7 To maxrow2
str2 = ws2.Cells(row2, "E").Value
For row1 = 6 To maxrow1
str1 = ws1.Cells(row1, "G").Value
If InStr(str2, str1) > 0 Then
ws2.Cells(row2, "F").Value = ws1.Cells(row1, "H").Value
Exit For
End If
Next
Next
MsgBox ("完了")
End Sub

この回答へのお礼

tatsumaru77さん、再度ご回答下さり、そのまま使えるコードまで書いて下さり本当にありがとうございました。

ループの中にループを入れるのがやはり正解なのですね。関数に入れる文字列を定義することですっきりとInStr関数を使えるんだな…とか、最初にClearContentsね!!とか、No2の方に教えて頂いた内容に加えてさらに発見がありました。

ベストアンサー、No2の方は私の理解力に合せて自分で書けるように教えて下さったのだと思ってすごく有り難かったですが、一番最初&フルコースなご回答を下さったtatsumaru77さんにつけさせて頂きます。

本当に祝日の朝早くからありがとうございました。お二人ともよい祝日をお過ごしください！

お礼日時：2021/09/23 11:39

No.2 回答者： mygoonickname 回答日時： 2021/09/23 09:47

おはようございます。

先ずは、基本的なループで処理されるのが、良いかと思います。
あと、部分一致検索ですと、Like演算子が便利な機能だと思います。
例えば、下記の様な記載を基本に作成されては？と思います。
（全て手書きですので、エラーが出るかも知れませんが。）

Dim I As Long,J As Long

For I＝２ To 4
For J=2 To 4
If Cells(I,2).Value Like "*" & Cells(J,5).Value & "*" Then
Cells(I,3).Value = Cells(J,6).Value
Exit For
End If
Next J
Next I

処理スピードについては、どうしても時間が掛かり過ぎる時に、その時、
　考えたら良いのでは？と思います。
先ずは、動くマクロを作るのが先かと思います。

この回答へのお礼

おはようございます、朝早くからコードをご教示下さりありがとうございます。

サンプルに作ったファイルで早速やってみたら成功、行数を増やしたらどのくらいかかるのかなと思ってiを700まで、jを10までにしたのですが、瞬時に終わってびっくりしました…。

Like演算子、こんなふうに使えるんですね…！！この考え方は色々に使っていけそうで、感謝でいっぱいです（周囲にVBAに長けてる人がおらず困り果てていたので有り難くて泣きそう）、本当にありがとうございました。

お礼日時：2021/09/23 10:17

No.1 回答者： tatsumaru77 回答日時： 2021/09/23 09:28

補足要求です。

１．利用店舗とリストは同じシートでしょうか。
異なるシートなら、
①それぞれのシート名を提示してください。
②ドトール赤坂店のセルの位置を提示してください。（A2等）（利用店舗の1番目のデータのセル位置）
③ドトールのセルの位置を提示してください。（A2等）（リストの1番目のデータのセル位置）
同じシートなら、利用店舗とリストは提示された通りのセルの位置であると理解してよいですか。

２．利用店舗のデータ件数は最大何件程度でしょうか。

３．リストのデータ件数は最大何件程度でしょうか。

データ件数が非常に多い場合は別ですが、最初から高速な処理を意識する必要はないかと思います。
まずは、正しく処理が行われるにすることが先決で、それで、処理時間がかかり困るようなら、
その時点で、高速化を考えればよいかと。

この回答へのお礼

朝早くからありがとうございます。補足要求を拝見しまして、そのまま使えるようなコードを書いて下さるのかなと大変感激しています、ありがとうございます。

1①シートは定義して、リストのほうをws1、利用店舗が並んでいるほうをws2にしています。

1②と2　ws2.range("E7:E806")です。
1③と3　ws1.range("G6:H50")です。

何卒よろしくお願い致します。

お礼日時：2021/09/23 09:49