[[20121010145211]]　『住所の照合、部分一致』（なっちゃん）　ページの最後に飛ぶ

『住所の照合、部分一致』（なっちゃん）
@2007 win7

A列に住所、B列にも住所が記載されています。
AとBを比べて似ている場合に、セルに色付けをしたいです。

AとBは違う住所であって欲しいのですが、時折同じ住所がある場合があります。

しかし、記述方法が、大阪府○○市○○までは同じなのですが、それ以降の番地が、
１－１と書いてあるものや、1-1と半角だったり、1番1号と書いてあったりします。

条件付書式でA1=B1では完全一致なので、難しいです。

完全一致の照合が難しいので、一致していなくても似ている住所、怪しい住所だけでも色付けできたらと思います。

具体的には○○市○○町くらいまでの一致で色付けできれば、丁目以降は目視で確認できればと思うのですが。
しかし、○○町が入らない住所もあってどうしていいのかわかりません。。。

何か良い方法はないでしょうか。

 とりあえず、それぞれ昇順で並べ替えてみる、というのでは如何でしょうか？

 （あー、順番は変えられないんです。とかのパターンかな。）

 （コナミ）

ご返答ありがとうございます。

順番は変えられないというか、他列にもデータは入ってますので、
範囲を広げないソートをすると、他列とのデータ関連性がなくなってしまうと思うのですが。。

何か私が勘違いしているのでしたら申し訳ございません。

（なっちゃん）

 >順番は変えられないというか、他列にもデータは入ってますので

 あー、そこまでは私、千里眼ではないので書いていただかないとわからないものですから…
 なにせ回答がついてなかったのが気になったものですからとっかかりにでも、と書いただけですし。

 VBAを使用しないのでしたら、とりあえず左から10文字くらいを抜き出して比較してみるとかでは
 どうでしょう。

 ちょっと前に記述が微妙に違う住所を比べるコードを回答されていた質問があったような気も
 するんですが…

 （コナミ）

 この手の照合は、つまるところ人間の目でしかできないというか、もしやるなら、人工知能というか、そんな複雑なロジックが必要なんだろうなと思う。

 あやしそうなもの・・・・う～ん、そうなるかどうか不安だけど。
 あやしいかもしれないもののＡ列を黄色くしているつもり。どうかなぁ・・・・

 Sub Sample()
    Dim c As Range
    Dim adr1 As String
    Dim adr2 As String
    Dim re As Object
    Dim mt As Object

    Set re = CreateObject("VBScript.RegExp")
    With re
        .Pattern = "[0-9０-９]"
        .Global = False
    End With

    With Sheets("Sheet1")   'シート名は適切なものに
        .Columns("A").Interior.ColorIndex = xlNone
        For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
            adr1 = c.Value
            adr2 = c.Offset(, 1).Value
            Set mt = re.Execute(adr1)
            If mt.Count > 0 Then adr1 = Left(adr1, mt(0).firstindex)
            Set mt = re.Execute(adr2)
            If mt.Count > 0 Then adr2 = Left(adr2, mt(0).firstindex)
            If InStr(adr1, adr2) > 0 Or InStr(adr2, adr1) > 0 Then c.Interior.Color = vbYellow
        Next
    End With
 End Sub

 (ぶらっと)

 ↑　Global は　デフォルト False なので

    With re
        .Pattern = "[0-9０-９]"
        .Global = False
    End With

 これは

    re.Pattern = "[0-9０-９]"

 この１行でもいいね。

 (ぶらっと)

コナミ様⇒
申し訳ございませんでした。確かに仰る通りです。。

質問するのに簡素的な方が伝わりやすいかと思っていたので。
左10文字目くらいまでというのはLEFTとEXACTとかですかね？？

過去の「微妙に違う住所」というのを検索してみます。

ありがとうございます。

ぶらっと様⇒

ありがとうございます。
確かにこういうのが得意なのは人間なんだな～と思います。
怪しいところだけでも注意できればと思いましたので。

VBA使ってみたら、いい感じでした。

ただVBAは初心者なので書かれている事がほとんどわからないですが、これで大丈夫だと思います。

ちょっと記述内容確認して勉強してみます。

お二人ともありがとうございました。

（なっちゃん）

 ごめんなさい、確認したらその質問は一件、一件で表示が違ったりするけど比較する住所の表記は
 統一されてました。
 やっぱり、微妙な違いは目視で確認しないとだめなんですね。

 ちょっといやらしい書き方して申し訳なかったのですが、回答側は本当に書かれている内容が
 すべての情報ですので、データの情報はなるべく詳しく載せてもらった方が助かります。

 ですので、回答がついてなかったりすると少しでも何かアクションをしてもらって、その反応で
 情報を追加していくのです。
 聞いては見たものの、手に負えませんしたorzみたいなこともよくありますけどね。
 （コナミ）

コナミ様

いえいえ。
こちらこそ申し訳ございませんでした。
次からは気をつけます。

ぶらっと様のVBAは取り回すには私のレベル不足だったので、
レベルが到達するまでは、コナミ様のアドバイスを元に、
LEFTとEXCATである程度の代用を考えてみました。

アドバイスがないと思いつきもできないので、その点でも非常に助かりました。

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

（なっちゃん）

 こんな感じでいいんじゃないの？

 Sub test()
    Dim r As Range, flg As Boolean
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\d+)(\D+)?"
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            flg = _
            .Replace(StrConv(r.Value, vbNarrow), "$1-") = _
            .Replace(StrConv(r(, 2).Value, vbNarrow), "$1-")
            If flg Then r(, 2).Interior.Color = vbRed
        Next
    End With
End Sub

 修正
 >AとBを比べて似ている場合に、セルに色付けをしたいです。
(seiya)

 もし関数でやるとすると（私には手が負えないんだけど）私がアップしたコードをベースに疑似関数（？）で書いてみると
 A列、B列それぞれの値を　全角->半角　変換し（ASC? JIS?)
 それぞれの変換結果で最初に数字が登場する手前までの文字列を作成し
 それぞれの文字列が他方の文字列内にあるかどうか、あれは【あやしい】

 こんなことをずらっと組み込んだ式になるんだろうね。
 で、この式を A列のセルの条件付き書式の数式に登録して、あやしければ背景色を付ける。

 こんなことなんだろうと思う。

 ただ、このロジックでいいのかどうかは？？？？だけどね。
 あやしくなくともあやしいと判断されるのは、まだしも、あやしいのに、あやしいとみなされなければ
 作業精度として問題ありなので。

 でも、アップしたコードを関数で処理するなら、こんなところかな？
 エキスパートさんだったら、ちょちょいのちょいなんだろうね。

 (ぶらっと)

コメント返信：

[ 一覧(最新更新順) ]

[[20121010145211]] 『住所の照合、部分一致』（なっちゃん） ページの最後に飛ぶ

[[20121010145211]]　『住所の照合、部分一致』（なっちゃん）　ページの最後に飛ぶ