こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

EXCEL VBAで語句の一部が一致する値の検索方法について

すいませんEXCEL VBAで教えていただきたいことがあります。

A列:
1行:"東京都小笠原村逆川"
2行:"神奈川県横須賀市中町二丁目"
3行:"山梨県甲府市曙町2番地"
4行:"埼玉県さいたま市大宮区土手町三丁目"


(100行目までデータが入力されている)

C列:
1行:"神奈川県縦須賀市谷町二丁目"
2行:"先玉県埼玉市大宮区土手町一丁目"
3行:"東京都小笠原村順川"
4行:"山梨県甲府村曙町3番池"


(150行目までデータが入力されている)

これらのデータが入っているとします。
ここで、
B列:
A列のデータと6文字以上一致するC列の行数を、A列に対応する行に記載。
1行:"3"
2行:"1"
3行:"4"
4行:"2"


このB列の処理を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 = ""

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

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

投稿日時 - 2008-02-19 22:31:21

QNo.3791621

困ってます

質問者が選んだベストアンサー

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

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

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

A:文字の位置ごとに判断する場合
 「×××××××市」で1
B:前者を基準に順序を考慮する場合
 「*埼玉*市*」なので3
C:後者を基準に順序を考慮する場合
 「*さいたま*市*」なので5
D:順序を考慮せず比較する場合
 {さ・い・た・ま・県・埼・玉・市}で8

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

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

●甲案:ルールB(前者を基準に順序を考慮)でカウント
'-------------------------------------------------------
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
'-------------------------------------------------------


●乙案:ルールD(順序を考慮しない)でカウント
'-------------------------------------------------------
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で動作確認済

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

以上ご参考まで。

投稿日時 - 2008-02-21 22:07:32

お礼

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

投稿日時 - 2008-02-22 00:09:00

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

こんばんは。

元のデータでは、少し無理がありませんか?
>A列のデータと6文字以上一致するC列の行数を、A列に対応する行に記載。
>1行:"3"
>2行:"1"
>3行:"4"
>4行:"2"

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

投稿日時 - 2008-02-20 01:53:57

お礼

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

投稿日時 - 2008-02-21 23:43:24

あなたにオススメの質問