ＥＸＣＥＬ ＶＢＡで頭の５文字と語尾の５字が一致する語の検索方法について

質問

すいませんＥＸＣＥＬ　ＶＢＡで教えていただきたいことがあります。

Ａ列：
１行："山手線高田馬場"
２行："中央線西国分寺"
３行："横須賀線逗子海岸"
４行："南武線東府中本町"
・
・
（１００行目までデータが入力されている）

Ｄ列：
１行："横須賀線豆子海岸"
２行："南部線北府中本町"
３行："湘南新宿パイン上尾"
４行："山手線低田馬場"
５行："中央線東国分寺"
６行："南部線南府中本町"
・
・
（１５０行目までデータが入力されている）

これらのデータが入っているとします。
ここで、
Ｂ列：
Ａ列の各データの最初の３文字と最後の３文字が一致するＤ列の行数をＡ列に対応する行に記載。
なお、該当するデータが必ずＤ列に存在するとは限りません。（該当無しのときはＢ列のセルは空欄）

１行："４"
２行："５"
３行："１"
４行："２"
・
・

Ｃ列：Ａ列のセルの最初と最後の３文字が一致するＤ列のデータが２つある場合はＡ列に対応する行に記載
１行：""
２行：""
３行：""
４行："６"
・
・
このＢ列とＣ列の処理をEXCEL VBAで行うにはどうしたらいいのでしょうか。
Dim i as integer
i = i + 1
Do Until
Loop
というような式を使うんじゃないかという気はしますが
具体的な式が思い浮かびません。
よろしくお願いします。

回答No.1

nekotaru · ベストアンサー

こんな感じでしょうか？
※Ｄ列は南部線ではなく、南武線でいいでしょうか？
処理効率は考えてません

Sub AAA()

Dim wRowA As Long

wRowA = 1

Do Until Cells(wRowA, "A").Text = ""

Call BBB(wRowA)

wRowA = wRowA + 1
Loop

MsgBox ("A")
End Sub

Sub BBB(wRowA As Long)

Dim wRowD As Long

wRowD = 1

Do Until Cells(wRowD, "D").Text = ""

If Left(Cells(wRowA, "A"), 3) = Left(Cells(wRowD, "D"), 3) And _
Right(Cells(wRowA, "A"), 3) = Right(Cells(wRowD, "D"), 3) Then
If Cells(wRowA, "B").Text = "" Then
Cells(wRowA, "B").Value = wRowD
Else
Cells(wRowA, "C").Value = wRowD
End If

End If

wRowD = wRowD + 1
Loop

End Sub

お礼

おおっ！！出来ました！！
ありがとうございます。

なるほど
Do Until で
Call BBB(wRowA)
を導くのですか。
マニュアル本だと
Do Until Cells(wRowA, "A") = Cells(wRowd, "D")
というように一つにまとめるやり方しか載っていないので
強引にこのやり方を引っ張って四苦八苦していました。

処理効率は教えていただいた式で十分速いので問題になりません。
どうもありがとうございました。