住所のセル分割について

お尋ねします
A1のセル→＊＊山田町1-1-1山田アパート＊＊
のように番地とアパート・マンション名が続けて入っているセルがいくつもあります。
これを
B1→＊＊山田町1-1-1
C1→山田アパート＊＊
のように２つのセルに分割する方法はありませんでしょうか。
番地とアパート名の間にはなにもありません。
また番地までの住所の長さはまちまちです。
よろしくお願いいたします。

No.7 ベストアンサー 回答者： imogasi 回答日時： 2003/12/21 14:30

非常に微妙な論理を使ってますが、下記を実行して、ほぼうまく行けば使って見てください。

（１）テストとして、１００行分のぐらいの住所を別シートのＡ列にコピーする。そして下記を実行し、Ｂ、Ｃ列に分離された内容が、圧倒的行数で正しいかチェック。不適当が少数なら手で修正する。
ロジックは文字部の塊が終わり、数字かハイフンが出現し、再び文字の現れた個所以下を気付・アパートとする。
Sub test01()
For i = 1 To 100 '1000行までなら１０００に変える
s = Cells(i, "A") '住所のある列、Ｃ列なら"C"
For j = 1 To 30 '30は1000人の住所全体の最大文字数
c = Mid(s, j, 1) '住所のｊ番目文字を問題にする
Select Case c
Case Is = IsNumeric(c) '数字か
flg = 1
Case "０" 'ゼロか
Case "-" 'ハイフンか
Case "－" 'ハイフンか
Case Else
If flg = 1 Then
Cells(i, "B") = Mid(s, 1, j - 1) '分離後住所本体部を置く列
Cells(i, "C") = Mid(s, j, 10) '気付アパート部を置く列
flg = 0
GoTo p01
Else
flg = 0
End If
End Select
Next j
p01:
Next i
End Sub
（２）旨くいく条件
町字までの住所本体には数字や－がないとする．
丁・番・号には数字か－しかないものとする。１丁目とか２番地などの表現がないこと。
ＶＢＡの実行はシートでＡＬＴ＋Ｆ１１
ＶＢＥ画面で挿入（Ｉ）、標準モジュール（Ｍ）で出てくる画面に貼りつけ、Ｆ５キーで実行。
（テスト）
静岡市山田１－２山田マンション１２３４
仙台市新町１－２－３ＡＢＣアパート
大手町２－３－４富士ビル３階
大阪市中央区大手町１－２０沖縄
大阪市北区駅前１－２１希望１－２３４
東京都千代田区大手町３－３－３日本ビル１２３
埼玉県さいたま市宮前２－３－４　金剛３３３
埼玉県さいたま市宮前２－３－４
Ｃ列は
山田マンション１２３
ＡＢＣアパート
富士ビル３階
沖縄
希望１－２３４
日本ビル１２３
　金剛３３３
となりました。

この回答へのお礼

丁寧なご説明有難うございます。
#4さんにも描いたのですが番地の前に数字が入っているものが100件ほどありましたが、後はうまくいきました。
VBAは便利なものですね。
自分でも勉強してみようと思います。
本当に助かりました。

お礼日時：2003/12/21 21:13

No.6 回答者： diashun 回答日時： 2003/12/21 13:12

またまた＃４です。

データが１０００件ほどあるとのことですので、
「For RowCnt = 0 To 10」のところを「0 To 999」とデータ数に応じた数値に変えてください。

この回答へのお礼

本当に何度もすみません。
実行してみましたところほぼうまくいったのですが、番地の前に数字の入っているものが100件ほどありそれは地道になおしていこうと思います。
ありがとうございました。

お礼日時：2003/12/21 21:09

No.5 回答者： diashun 回答日時： 2003/12/21 13:09

＃４です。

一部間違いを訂正してください。
×「半角"="（ハイフン）→ ○「半角"-"（ハイフン）
以上

No.4 回答者： diashun 回答日時： 2003/12/21 13:07

VBAマクロでよければ下記のコードをマクロの標準モジュールにコピー＆ペーストして「マクロ実行」で試してみてください。

ただし下記の制約が必要です。
１．番地表記が必ず半角数値で半角"="（ハイフン）でつながっていること。
２．アパート名の先頭文字が半角数字でないこと。
３．番地より手前の住所に半角数値が入っていないこと。
４．元住所がA列の1行目から下方向へあること
５．分割されたデータはそれぞれB列C列に入ります。
***ここからコピー
Option Explicit

Private Sub Split_Str()
Dim strAdd1 As String, strAdd2 As String, strAdd3 As String
Dim i As Integer, blnFlg As Boolean
Dim RowCnt As Integer

ThisWorkbook.Sheets(1).Activate

For RowCnt = 0 To 10
strAdd1 = Cells(1 + RowCnt, 1).Value
If strAdd1 = "" Then Exit For

blnFlg = True
For i = 1 To Len(strAdd1)
Select Case Mid(strAdd1, i, 1)
Case "0" To "9"
strAdd2 = Mid(strAdd1, 1, i)
blnFlg = False
Case "-"
strAdd2 = Mid(strAdd1, 1, i)
blnFlg = False
Case Else
If blnFlg = True Then
strAdd2 = Mid(strAdd1, 1, i)
Else
strAdd2 = Mid(strAdd1, 1, i - 1)
strAdd3 = Right(strAdd1, Len(strAdd1) - Len(strAdd2))
Cells(1 + RowCnt, 2).Value = strAdd2
Cells(1 + RowCnt, 3).Value = strAdd3
Exit For
End If
End Select
Next i
Next RowCnt
End Sub
***ここまでコピー
元データが別の列、行にある場合は補足でお知らせ下さい。

No.3 回答者： shiga_3 回答日時： 2003/12/21 12:22

＃１です。

先ほどの式は半角スペースが無い（住所１しか無い）場合エラーが出てしまいますので、もし使われることになった場合は
B1を「=IF(ISERROR(FIND(" ",A1))=TRUE,A1,LEFT(A1,FIND(" ",A1)-1))」
C1を「=IF(ISERROR(FIND(" ",A1))=TRUE,"",RIGHT(A1,LEN(A1)-FIND(" ",A1)))」
としてください。
なお今後は＃２さんのおっしゃるように分けて書いた方が融通がきくので、変換後、範囲をコピーして「形式を選択して貼り付け」で値のみ貼り付けで文字列にされて、今後は分けて書くというようにされた方が良いかもしれないですね。
しかし1000件は大変ですね。もっと簡単な方法がないかなぁ・・・。もし思いついたら書き込みしますね。

No.2 回答者： noname#49904 回答日時： 2003/12/21 11:35

　単に住所欄を設定する場合、最低で住所1.住所2のセルが必要で、業務で使用なら最低でも住所3が必要です。

　一つのセルにおっしゃるような書き込みをされている場合、件数にもよりますが、手直しでするより方法が無いと思います。
　通常は、Ctrl+X,C,Vなどのキーでコピペでします。
　住所録は、後々の利用を考えて最初から慎重な設計が求められるものです。
　Excel　Access　Lotus　ともに同じです。

この回答へのお礼

有難うございました。
#1の方にも書いたのですが、件数は約1000件ほどです。
ご指摘の通り最初のデータ入力方法が大切だったのですが…。
皆さんのお知恵を拝借すれば何か手がかりが得られるかと思いまして。
次回からは慎重にデータを作っていきたいと思います。

お礼日時：2003/12/21 11:50

No.1 回答者： shiga_3 回答日時： 2003/12/21 11:15

間に何も入っていなくて、分ける前後の文章にも規則性が無いとなると、それを判別させるのは難しいような気がします。

もし分けたい部分を半角スペースで区切るというのであれば、
A1に「＊＊山田町1-1-1 山田アパート＊＊」
B1に「=LEFT(A1,FIND(" ",A1)-1)」
C1に「=RIGHT(A1,LEN(A1)-FIND(" ",A1))」
で対処できますが・・・。

件数が多いと大変かも知れませんが、しばらく回答を待たれて有効な回答が得られなかった場合は、とりあえず一つ一つスペースを入れていかれたらいかがでしょうか。

この回答へのお礼

回答有難うございます。
何人もの方がデータを書き足ししていったもので1000件近くもあります。
教えていただいた通り、しばらく回答を待ってみてだめなときはスペースを入れていきたいと思います。

お礼日時：2003/12/21 11:47