住所録からマンション名以下を別セルへ

質問

住所が一つのセルに入っているものを
マンション名、もしくはなんとかハイツ系、なんとか荘系、
とはいってるものは別セルに表示したいのです。

例
A1 東京都○○区淡路町2-1-11光マンション222
A2 大阪府○○区外井場3-1-1
A3 広島県○○区草薙場5-3-1 水蔵荘20号

この場合
B1「東京都○○区淡路町2-1-11」別セルC1にて「光マンション222」
B2 「大阪府○○区外井場3-1-1」でOK
B3 「広島県○○区草薙場5-3-1」別セルC3にて「水蔵荘20号」

となるようにするためにはどしたらいいんでしょうか？

住所の全角数字はすべて半角数字には置換しました。

可能かなと思える検索条件は
マンション前には半角の"1,2,3,4,5,6,7,8,9,0,半角スペース"
があり、その後は全角の文字でマンション名がある
という事なんです。

つまり、最後の半角の後に全角の文字があるものはという事なんで
大丈夫だなと思っていたつもりだったのですが

よく考えたら、マンションの最後の部屋番号も半角文字だ。。。。

さらに問題はマンション名が半角カタカナのものもある。
※ただ、これについては最悪、置換で全角に変えようかなとも思います。
（その前に半角カナを全角カナに変える関数ってあるんですか？）

さて、これらの条件でマンション名以降だけを別セルにすることできるのでしょうか？
もしわからなければ、ウン万行のデータを手作業で・・・行わないといけないのです・・・・・。

ぜひ、よろしくお願いいたします。

回答No.4

zap35 · ベストアンサー

＃０１です。
少しだけマクロを変えました。「半角数字と全角カナ」「半角数字と空白」も区切りと考えるようにしています

＞そこでとまってしまってます。
これを前回説明した場所に貼り付けたら、VBE画面は閉じてしまってかまいません。ワークシート画面に戻って適当なセルに、たとえば
　=GetSep(A1)
のように式を入れてみてください。ブックを保存すればマクロも一緒に保存されますので、保存を意識する必要はありません。

私は
　Ｂ１の式は　　=LEFT(A1,getsep(A1))
　Ｃ１の式は　　=TRIM(RIGHT(A1,LEN(A1)-getsep(A1)))
にしています。

Function GetSep(ByVal trg As Range) As Integer
Dim RE, mchItems
Dim strPattern As String
Dim idx As Integer
If trg <> "" Then
　　Set RE = CreateObject("VBScript.RegExp")
　　strPattern = "-[0-9]+|[0-9][ァ-ン]|[0-9] |[0-9]　"
　　With RE
　　　　.Pattern = strPattern
　　　　.IgnoreCase = True
　　　　.Global = True
　　　　Set mchItems = .Execute(trg.Value)
　　　　If mchItems.Count > 0 Then
　　　　　　GetSep = mchItems.Item(mchItems.Count - 1).FirstIndex _
　　　　　　　　　　+ mchItems.Item(mchItems.Count - 1).Length
　　　　Else
　　　　　　GetSep = Len(trg.Value)
　　　　End If
　　End With
　　Set RE = Nothing
End If
End Function

結果はこうなりました。到底「完全なレベル」にはなりません。
ただ住所の末尾　1-12-5　とマンション名の間に空白を入れると分離できますので、うまくいかないデータはそのように修正してください

Ｂ列　　　　　　　　　　　　　　　　　　　　　　　　　Ｃ列
○○府○○市○○丘1-12-5　　　　　　　　　　セ○○○○泉丘101号
○○県○○市○○野区東○○台1-3-3　　　　　　佐藤ハイツ2N
○○都○○区大○○町3-22-21　　　　　　　　　○○○○園403
○○都○○区○○谷3-42-14　　　　　　　　　　ス○○山101
○○県○○市○○町1234-1　　　　　　　　　　　○○○○エストe502
○○県○○市○○区○○町1-20　　　　　　　　　コーポ○○102
○○県○○市○○西2-3-2　　　　　　　　　　　　グリーン○○西101
○○県○○市○○郷4321-4　　　　　　　　　　　サニー○○204
○○県○○市○○区○○町5472 　　　　　　　　　○○備前303
○○県○○市○○町方五23-4　　　　　　　　　　　スミエ-ルミクラシ05号
○○府○○市○○区○○町鷲見99パ　　　　　　　　ルテオン東山南209　→　NG（なんでかなぁ）
○○府○○府○○市○○○○台3丁目4番129-101　　　号　→　NG（ルール通り）
○○県○○県○○市○○○○12-2135　　
○○府○○市○○町5-12　　　　　　　　　　　　　坂本ハイツ3-B
○○県○○市○○町821エステートブリッツンC-101　　→　NG（ルール通り）

なお＃０２式はすごいですね。ちょっと考えましたが動く理由がまだ理解できません。いつもながらmaron--5さんの作る関数式には感心します。

お礼

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

回答No.3

noname#176215

この手のものに汎用性を期待するのは 時間の無駄だと思います。
ある程度は 目で確認してエラーチェックした方がいいと思います。

条件を増やし過ぎると 処理が重くて使い物にならなくなりますよ？

■B1セル：作業列(番号以下)
=REPLACE(A1,1,MIN(FIND({1,2,3,4,5,6,7,8,9,0,
"１","２","３","４","５","６","７","８","９","０"},
A1&"1235467890１２３４５６７８９０"))-1,"")

■C1セル：住所
=TRIM(SUBSTITUTE(A1,D1,""))

■D2セル：ビル・マンション名
=TRIM(REPLACE(B1,1,MIN(INDEX((ISERR(-MID(B1&".",COLUMN(1:1),1))
+ISNUMBER(-MID(B1,COLUMN(1:1)+1,1))+ISNUMBER(FIND(MID(B1,COLUMN(1:1)+1,1),
"-－丁番号"))+(MID(B1,COLUMN(1:1)+2,1)="."))*256+COLUMN(1:1),0)),""))

お勧めする訳ではありません。興味本位の実験みたいなもんです。

回答No.2

maron--5

◆関数で
B1=LEFT(A1,LOOKUP(1,0/FIND("-",A1,COLUMN(1:1)),COLUMN(1:1))+SUMPRODUCT(--ISNUMBER(0/MID(A1,LOOKUP(1,0/FIND("-",A1,COLUMN(1:1)),COLUMN(1:1)),{1,2,3,4}))))
★下にコピー

C1=TRIM(REPLACE(A1,1,LEN(B1),))
★下にコピー

補足

すごいです！
式の内容はわかりませんが、結構な確率でできてます。

○○府○○市○○丘1-12-5セ○○○○泉丘101号　OK
○○県○○市○○野区東○○台1-3-3佐藤ハイツ2N　OK
○○都○○区大○○町3-22-21 ○○○○園403　OK
○○都○○区○○谷3-42-14ス○○山101　OK
○○県○○市○○町1234-1 ○○○○エストe502　OK
○○県○○市○○区○○町1-20 コーポ○○102　OK
○○県○○市○○西2-3-2グリーン○○西101　OK
○○県○○市○○郷4321-4 サニー○○204　OK

で、下記の条件についてはダメでした・・・

○○県○○市○○区○○町5472 ○○備前303　　B,Cともにエラー
○○県○○市○○町方五23-4スミエ-ルミクラシ05号　　Cにルミクラシ05号（これは単純に半角にしたほうがいいですね）
○○府○○市○○区○○町鷲見99パルテオン東山南209　　B,Cともにエラー
○○府○○府○○市○○○○台3丁目4番129-101号　　Cに[号]が残る
○○県○○県○○市○○○○12-2135 Cに[5]が残る
○○府○○市○○町5-12坂本ハイツ3-B　Cに[B]が残る
○○県○○市○○町821エステートブリッツンC-101　わけられない

これらについて、簡単であればおしえていただけないでしょうか？

回答No.1

zap35

＞よく考えたら、マンションの最後の部屋番号も半角文字だ。。。。
deepimpactさんもお気づきですね。これだけではまだ「条件が不十分」です。

ですから最後に出現する「-（半角ハイフン）につづく半角数字」を区切り文字として扱うようにしてみます。「完全に」とまで言えなくてもかなり救えるはずです。

まず以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。

Function GetSep(ByVal trg As Range) As Integer
Dim RE, mchItems
Dim strPattern As String
Dim idx As Integer
If trg <> "" Then
　　Set RE = CreateObject("VBScript.RegExp")
　　strPattern = "-[0-9]+"
　　With RE
　　　　.Pattern = strPattern
　　　　.IgnoreCase = True
　　　　.Global = True
　　　　Set mchItems = .Execute(trg.Value)
　　　　If mchItems.Count > 0 Then
　　　　　　GetSep = mchItems.Item(mchItems.Count - 1).FirstIndex _
　　　　　　　　　　+ mchItems.Item(mchItems.Count - 1).Length
　　　　End If
　　End With
　　Set RE = Nothing
End If
End Function

これは最後の「-（半角ハイフン）につづく半角数字」の終わりが先頭から何文字目かを返すユーザ定義関数です。ワークシートに戻り
　=GetSep(A1)
と式を入力すると「15」が返ります。

あとはこのユーザ定義関数を用いて、B1セルは
　=LEFT(A1,GetSep(A1))
C1セルは
　=TRIM(MID(A1,GetSep(A1)+1,LEN(A1)))
を入力し下方向にコピーします

すると結果は以下のようになります。
Ｂ列　　　　　　　　　　　　　　　　　　Ｃ列
東京都○○区淡路町2-1-11　　光マンション222
大阪府○○区外井場3-1-1　　
広島県○○区草薙場5-3-1　　水蔵荘20号

これで多少楽になりませんか？

補足

ありがとうございます。
でも
すいません。
VBAわかんなくて説明していただいてる
貼り付けまでやったのですが
それをどう保存？すればいいのかわからないのです。
そこでとまってしまってます。
よろしければ教えていただけないでしょうか？

また、上の方の欄にも答えてますが
色々な形のリストがあるので
参考になればと参考にされてくださいませんか？
どうぞよろしくお願いいたします。