ＥＸＣＥＬ ＶＢＡで語句の一部が一致する値の検索方法について

質問

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

Ａ列：
１行："東京都小笠原村逆川"
２行："神奈川県横須賀市中町二丁目"
３行："山梨県甲府市曙町２番地"
４行："埼玉県さいたま市大宮区土手町三丁目"
・
・
（１００行目までデータが入力されている）

Ｃ列：
１行："神奈川県縦須賀市谷町二丁目"
２行："先玉県埼玉市大宮区土手町一丁目"
３行："東京都小笠原村順川"
４行："山梨県甲府村曙町３番池"
・
・
（１５０行目までデータが入力されている）

これらのデータが入っているとします。
ここで、
Ｂ列：
Ａ列のデータと６文字以上一致するＣ列の行数を、Ａ列に対応する行に記載。
１行："３"
２行："１"
３行："４"
４行："２"
・
・
このＢ列の処理をEXCEL VBAで行うにはどうしたらいいのでしょうか。

Sub AAA()
Dim wRowA As Long
wRowA = 1
Do Until Cells(wRowA, "A").Text = ""
Call BBB(wRowA)
wRowA = wRowA + 1
Loop
End Sub

Sub BBB(wRowA As Long)
Dim wRowD As Long
wRowD = 1
Do Until Cells(wRowD, "C").Text = ""

'Ａ列の値と６文字以上一致するＣ列のセルがあるときは
If ・・・・・・・・・・ Then
Cells(wRowA, "B").Value = wRowD
End If
wRowD = wRowD + 1
Loop
End Sub

ＩＦ以降の部分がどうも導き出せません。
よろしくお願いします。

回答No.2

noname#52504 · ベストアンサー

例えば、
「神奈川県横須賀市中町二丁目」
「神奈川県縦須賀市谷町二丁目」
を比べたとき、
｛神奈川県×須賀市×町二丁目｝
で11文字が一致、ということでしょうか？

人間であれば、どの部分がどの部分に対応するのかを
総合的に判断できますから単純なルールに思えますが、
機械に同じことをさせるのは結構大変です。

例えば、
「埼玉県さいたま市」と
「さいたま県埼玉市」では？

Ａ：文字の位置ごとに判断する場合
　「×××××××市」で１
Ｂ：前者を基準に順序を考慮する場合
　「*埼玉*市*」なので３
Ｃ：後者を基準に順序を考慮する場合
　「*さいたま*市*」なので５
Ｄ：順序を考慮せず比較する場合
　｛さ・い・た・ま・県・埼・玉・市｝で８

※Ａの場合、
　「埼玉県さいたま市大宮区土手町三丁目」
　「先玉県埼玉市大宮区土手町一丁目」
　　では、｛玉・県｝で２になります。

※Ｄの場合、
　「広島県福山市」「福島県山広市」でも
　（使われている文字は全て一致するので）６になります。

●甲案：ルールＢ（前者を基準に順序を考慮）でカウント
'-------------------------------------------------------
Sub AAA()
　そのまま
End SUB

Sub BBB(wRowA As Long)
　Dim wRowD As Long
　wRowD = 1
　Do Until Cells(wRowD, "C").Text = ""
　　If CCC(Cells(wRowA, "A").Text, Cells(wRowD, "C").Text) >= 6 Then
　　　Cells(wRowA, "B").Value = wRowD
　　　Exit Do '←HITした時点でDoループを抜ける
　　End If
　　wRowD = wRowD + 1
　Loop
End Sub

Function CCC(ByVal myStr0 As String, ByVal myStr1 As String) As Integer
　Dim ct As Integer
　Dim i As Integer
　Dim j As Integer
　Dim k As Integer
　ct = 0
　j = 1
　For i = 1 To Len(myStr0)
　　k = InStr(j, myStr1, Mid(myStr0, i, 1))
　　If k <> 0 Then
　　　j = k + 1
　　　ct = ct + 1
　　End If
　Next i
　CCC = ct
End Function
'-------------------------------------------------------

●乙案：ルールＤ（順序を考慮しない）でカウント
'-------------------------------------------------------
Sub AAA()
　そのまま
End SUB

Sub BBB()
　甲案と同じ
End SUB

Function CCC(ByVal myStr0 As String, ByVal myStr1 As String) As Integer
　Dim i As Integer
　Dim ct As Integer
　ct = Len(myStr1)
　For i = 1 To Len(myStr0)
　　myStr1 = Replace(myStr1, Mid(myStr0, i, 1), "", , 1)
　Next i
　CCC = ct - Len(myStr1)
End Function
'-------------------------------------------------------
いずれもExcel2003で動作確認済

なお、甲案，乙案いずれの場合も、
「○○県☆☆市△△町□丁目」と
「●●県★★市▲▲町■丁目」であれば、
｛県，市，町，丁，目｝だけで５文字一致になりますから、
６文字以上という基準ではゆるすぎるように思います。

以上ご参考まで。

お礼

ありがとうございます！とりあえず教えていただいたコードで検索をかけてみましたら格段にヒット数が増えました！！
実際のデータでは乙案の方がヒット数が多いみたいです。
Functionプロシージャの
myStr1 = Replace(myStr1, Mid(myStr0, i, 1), "", , 1)
の辺りがちょっとよくわからないので、今からテキストを見ながら勉強してみます。
またよろしくお願いいたします。

回答No.1

Wendy02

こんばんは。

元のデータでは、少し無理がありませんか？
>Ａ列のデータと６文字以上一致するＣ列の行数を、Ａ列に対応する行に記載。
>１行："３"
>２行："１"
>３行："４"
>４行："２"

6文字一致では、1つしかヒットしませんし、4文字までにしても、そのデータでは、4行目は、空欄です。

"埼玉県さいたま市大宮区土手町三丁目"

"先玉県埼玉市大宮区土手町一丁目"
（埼玉）
であっても、一致するのは、3文字までです。フリガナの取得だとかなり面倒です。

For i = 6 To 4 Step -1
一回だけなら、i = 6 To 6 です。

Sub TestMacro()
　　Dim c As Range
　　Dim r As Range
　　Dim dat As String
　　Dim i As Long
　　'最初にB列のデータを消す
　　Range("A1", Range("A65536").End(xlUp)).Offset(, 1).ClearContents
　　　For Each c In Range("A1", Range("A65536").End(xlUp))
　　　　For Each r In Range("C1", Range("C65536").End(xlUp))
　　　　　　'数を減らして、4までとする
　　　　　　For i = 6 To 4 Step -1
　　　　　　　　If r.Value Like Left(c.Value, i) & "*" Then
　　　　　　　　　　dat = dat & "," & r.Row
　　　　　　　　End If
　　　　　　　　If c.Offset(, 1).Value = "" Then
　　　　　　　　　　'書き出し
　　　　　　　　　　c.Offset(, 1).Value = Mid(dat, 2)
　　　　　　　　End If
　　　　　　　　dat = ""
　　　　　　Next i
　　　　Next r
　　Next c
End Sub

お礼

ありがとうございます。
For i = 6 To 4 Step -1
If r.Value Like Left(c.Value, i) & "*" Then
というやり方を始めて学びました。
教えていただいたコードで検索をかけましたところヒットした数が格段に増え、かなり前進しました。
文頭が間違っている語についてはLeftではなくRightで検索をかけてみます。
またわからないことがありましたらよろしくお願いいたします。