Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

7076 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【41140】住所の分割方法 pi 06/7/31(月) 18:30

【41142】Re:住所の分割方法 ponpon 06/7/31(月) 19:26

【41198】Re:住所の分割方法 pi 06/8/1(火) 18:05

【41149】Re:住所の分割方法 inoue 06/7/31(月) 22:36

【41200】Re:住所の分割方法 pi 06/8/1(火) 18:10

【41233】Re:住所の分割方法 角田 06/8/2(水) 18:04

【41157】Re:住所の分割方法 ｍ2ｍ10 06/8/1(火) 8:25

【41201】Re:住所の分割方法 pi 06/8/1(火) 18:15

【41225】Re:住所の分割方法 neptune 06/8/2(水) 14:17

【41363】Re:住所の分割方法 ｍ2ｍ10 06/8/7(月) 15:06

【41367】Re:住所の分割方法 neptune 06/8/7(月) 18:35

【41204】Re:住所の分割方法 ハチ 06/8/1(火) 19:56

【41237】Re:住所の分割方法 ハチ 06/8/2(水) 19:34

【41284】Re:住所の分割方法 ハチ 06/8/3(木) 19:54

【41227】Re:住所の分割方法 ｍ2ｍ10 06/8/2(水) 15:04

【41273】Re:住所の分割方法 pi 06/8/3(木) 16:07

【41278】Re:住所の分割方法 neptune 06/8/3(木) 16:55

【41289】Re:住所の分割方法 toshi 06/8/3(木) 21:27

【41290】Re:住所の分割方法 neptune 06/8/3(木) 22:38

【41292】Re:住所の分割方法 ハチ 06/8/3(木) 23:43

【41291】Re:住所の分割方法 漂流民 06/8/3(木) 23:22

【41294】Re:住所の分割方法 toshi 06/8/4(金) 0:00

【41295】Re:住所の分割方法 toshi 06/8/4(金) 0:50

【41296】Re:住所の分割方法 toshi 06/8/4(金) 1:31

【41372】Re:住所の分割方法 漂流民 06/8/7(月) 23:35


	【41140】住所の分割方法

pi - 06/7/31(月) 18:30 -


	引用なし

	パスワード

はじめまして。質問させてください。

A列に住所があり、それを分割してB列に都道府県名、C列に市区町村名、D列に残りを入れたいと考えています。
シート関数ではなくマクロで行いたいと思っています。
この掲示板の過去ログで、郵便番号のＣＳＶを利用すれば出来るようなことが書いてあったのですが、どのように活用すればいいのか見当がつきません。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=40597;id=excel
お力をお貸しください。よろしくお願いします。


	【41142】Re:住所の分割方法

ponpon - 06/7/31(月) 19:26 -


	引用なし

	パスワード

こんにちは。
郵便番号のＣＳＶではありませんが、参考になりますでしょうか？

http://www2.realint.com/cgi-bin/tarticles.cgi?sughi+575#576


	【41149】Re:住所の分割方法

inoue

- 06/7/31(月) 22:36 -


	引用なし

	パスワード

>どのように活用すればいいのか見当がつきません。
>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=40597;id=excel
そのページに書いてあるとおりです。

単に住所から「分解」するのは例外が数百種もあって不可能でしょう。
ですから「ゆうびんHP」のデータなどを利用して郵便番号か住所の一致を探して、
そのデータ上の分解された項目を各列にセットするようにします。

角田さんのアドインを利用するとか、
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_050.html
を参考にご自分でコードを作成するとか、
という方法ですが、ある程度のVBAの力量が必要です。


	【41157】Re:住所の分割方法

ｍ2ｍ10 - 06/8/1(火) 8:25 -


	引用なし

	パスワード

こんちは
　全国一括のデータファイルをアクセスに取り込み
　項目名[市区町村名]と[町域名]を参照住所が含むで
　SQLでつなげば、可能です。
　
　　


	【41198】Re:住所の分割方法

pi - 06/8/1(火) 18:05 -


	引用なし

	パスワード

▼ponpon さん：
>こんにちは。
>郵便番号のＣＳＶではありませんが、参考になりますでしょうか？
>
>http://www2.realint.com/cgi-bin/tarticles.cgi?sughi+575#576
ありがとうございます。研究してみます。


	【41200】Re:住所の分割方法

pi - 06/8/1(火) 18:10 -


	引用なし

	パスワード

▼inoue さん：
>>どのように活用すればいいのか見当がつきません。
>>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=40597;id=excel
>そのページに書いてあるとおりです。
>
>単に住所から「分解」するのは例外が数百種もあって不可能でしょう。
>ですから「ゆうびんHP」のデータなどを利用して郵便番号か住所の一致を探して、
>そのデータ上の分解された項目を各列にセットするようにします。
>
>角田さんのアドインを利用するとか、
>http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_050.html
>を参考にご自分でコードを作成するとか、
>という方法ですが、ある程度のVBAの力量が必要です。
ありがとうございます。私もその例外に悩み、この掲示板を頼りにきたのですが、難しいみたいですね。
角田さんのアドインとはどういうものでしょうか？


	【41201】Re:住所の分割方法

pi - 06/8/1(火) 18:15 -


	引用なし

	パスワード

▼ｍ2ｍ10 さん：
>こんちは
>　全国一括のデータファイルをアクセスに取り込み
>　項目名[市区町村名]と[町域名]を参照住所が含むで
>　SQLでつなげば、可能です。
>　
>　　
ありがとうございます。全国一括のデータファイルをアクセスに取り込むことはできたのですが、そこから先をどうしていいのか分かりません。
項目名[市区町村名]と[町域名]を参照住所が含むでSQLでつなぐとはどのようにすればよいのでしょうか？
具体的にご教授いただけるとうれしいです。よろしくお願いします。


	【41204】Re:住所の分割方法

ハチ - 06/8/1(火) 19:56 -


	引用なし

	パスワード

▼pi さん：

激しく遅いですがTextStreamの力技で。

ダウンロードしたKEN_ALL.CSVを
このファイルと同じフォルダに入れてください。
少ないデータ量で試してからにしたほうが良いです。

Option Explicit

Sub Test_BUNKATU()

Dim Str As String
Dim buf() As String
Dim Wr() As Variant
Dim Fg As Boolean
Dim myPath As String
Dim CSVFile As String
Dim FSO As Object
Dim R As Range
Dim ws As Worksheet

myPath = ThisWorkbook.Path
CSVFile = "\KEN_ALL.CSV"

Set ws = ThisWorkbook.Worksheets(1)
Set FSO = CreateObject("Scripting.FileSystemObject")

For Each R In Range(ws.Range("A1"), ws.Range("A65536").End(xlUp))
　　Fg = False
　　Str = R.Value
　　With FSO.GetFile(myPath & CSVFile).OpenAsTextStream
　　　　Do Until .AtEndOfStream = True
　　　　　　buf = Split(.ReadLine, ",")
　　　　　　buf(6) = Replace(buf(6), """", "")
　　　　　　buf(7) = Replace(buf(7), """", "")
　　　　　　If Str Like buf(6) & buf(7) & "*" = True Then
　　　　　　　　Fg = True
　　　　　　　　Exit Do
　　　　　　End If
　　　　Loop
　　　　.Close
　　End With
　　If Fg = True Then
　　　　Wr = Array(buf(6), buf(7), Mid(Str, Len(buf(6)) + Len(buf(7)) + 1))
　　　　R.Offset(, 1).Resize(, 3) = Wr
　　End If
Next R

Set ws = Nothing
Set FSO = Nothing

MsgBox "終了"

End Sub


	【41225】Re:住所の分割方法

neptune - 06/8/2(水) 14:17 -


	引用なし

	パスワード

▼pi さん：
>▼ｍ2ｍ10 さん：
ではありませんけど、
　
>ありがとうございます。全国一括のデータファイルをアクセスに取り込むことは
>できたのですが、そこから先をどうしていいのか分かりません。
少しはやろうとしてみたんでしょうか？

>項目名[市区町村名]と[町域名]を参照住所が含むでSQLでつなぐとはどのようにすればよいのでしょうか？
>具体的にご教授いただけるとうれしいです。よろしくお願いします。
where条件だけ
注：ADOなら * は % に変更して下さい。

where 分解したい住所 like '*' & [市区町村名] & '*'
and
分解したい住所 like '*' & [町域名] & '*'
でいけると思います。が、取り込んだままのテーブルではAccessとしては
かなり遅いと思います。
いろんな工夫をすれば早くなると思いますが、これはパス。

このまんまでは勿論動きませんから、自分の環境に合わせて書き直して下さい。


	【41227】Re:住所の分割方法

ｍ2ｍ10 - 06/8/2(水) 15:04 -


	引用なし

	パスワード

こんちは
郵便番号CSVから直接DAOで郵便番号からの取り込みを
作成しましたがＣＳＶの件数が多いので時間がかかります
直接アクセスからを勧めますが、
一応例として入れます。

条件列に　郵便番号　[1020072]
参照設定　DAO3.X　が必要です

Sub GEt001_DAO()

　　Dim db As Database
　　Dim rs As Recordset
　　Dim strPath As String
　　Dim Fname As String
　　Dim sql　 As String
　　Dim objra As Range
　　Dim objrb As Range
　　
　　strPath = Mid(ThisWorkbook.FullName, 1, InStrRev(ThisWorkbook.FullName, "\"))
　　Fname = "KEN_ALL.CSV"
　　　　
　　Set objra = Range(Range("A2"), Range("A65536").End(xlUp))
　　
　 For Each objrb In objra
　　 Range(objrb.Address).Select

　　 sql = "SELECT * FROM [" & Fname & "] " & _
　　　　 " WHERE F3='" & Range(objrb.Address).Value & "';"

　　 Set db = OpenDatabase(strPath, False, False, "TEXT;HDR=NO;")
　　 Set rs = db.OpenRecordset(sql, dbOpenDynaset)
　　 If rs.EOF = False Then
　　　ActiveCell.Offset(0, 2).Value = rs![f7]
　　　ActiveCell.Offset(0, 3).Value = rs![f8]
　　　ActiveCell.Offset(0, 4).Value = rs![f9]
　　 End If
　　 rs.Close
　 Next

db.Close
End Sub


	【41233】Re:住所の分割方法

角田

- 06/8/2(水) 18:04 -


	引用なし

	パスワード

こんにちは。
>角田さんのアドインとはどういうものでしょうか？
http://www.h3.dion.ne.jp/~sakatsu/TelPost.htm
> kt電話郵便アドイン
> (7) ktAddrSplit
>　　　区切りなく記述された住所の文字列を、郵便番号簿に載っている地方自治体に
>　　　したがって「都道府県 /市区町村/町域」に分割する関数です。
利用方法は、ダウンロードしてヘルプをご覧下さい。


	【41237】Re:住所の分割方法

ハチ - 06/8/2(水) 19:34 -


	引用なし

	パスワード

自分の勉強の為、作ってみました。
Dic_MakeでWorkSheets("住所Dic")を作ったあとに
分割するモジュールを２つ作ってみました

'郵政のKEN_ALL.CSVからWorkSheets("住所Dic")を生成する。
Sub Dic_Make()

Dim Ken, Sicho As String
Dim R, c As Long
Dim buf() As String
Dim myPath As String
Dim CSVFile As String
Dim FSO As Object
Dim Ws As Worksheet

myPath = ThisWorkbook.Path
CSVFile = "\KEN_ALL.CSV"

If Dir(myPath & CSVFile) = "" Then
　　MsgBox CSVFile & "がありません": Exit Sub
End If
For Each Ws In ThisWorkbook.Worksheets
　　If Ws.Name = "住所Dic" Then
　　　　Ws.Cells.ClearContents
　　　　Exit For
　　End If
Next Ws
If Ws Is Nothing Then
　　With ThisWorkbook
　　　　Set Ws = .Worksheets.Add(After:=Worksheets(.Worksheets.Count))
　　　　Ws.Name = "住所Dic"
　　End With
End If

Set FSO = CreateObject("Scripting.FileSystemObject")

Application.ScreenUpdating = False
R = 0: c = 0
With FSO.GetFile(myPath & CSVFile).OpenAsTextStream
　　Do Until .AtEndOfStream = True
　　　　buf = Split(.ReadLine, ",")
　　　　If Ken <> buf(6) Then
　　　　　　Ken = buf(6)
　　　　　　R = 1: c = c + 1
　　　　　　Ws.Cells(R, c).Value = Replace(Ken, """", "")
　　　　End If
　　　　
　　　　If Sicho <> buf(7) Then
　　　　　　Sicho = buf(7)
　　　　　　R = R + 1
　　　　　　Ws.Cells(R, c).Value = Replace(Sicho, """", "")
　　　　End If
　　Loop
　　.Close
End With
Application.ScreenUpdating = True
Set Ws = Nothing
Set FSO = Nothing

MsgBox "住所Dicが作成されました"

End Sub

'→方向に県をループして一致したら↓方向に市をループ
'県が省略されると分割できない。例）横浜市港南区・・・など
Sub Like_BUNKATU()

Dim Wr As Variant　 '書き出し用Array
Dim R, Tgt As Range　'ループ用,対象セル
Dim Ken_Ran, Sicho_Ran As Range '県Range,対象県の市町村Range
Dim Ken, Sicho As String '県,市町村
Dim DataSh As Worksheet 'データSheet
Dim DicSh As Worksheet　'辞書Sheet

For Each DicSh In ThisWorkbook.Worksheets
　　If DicSh.Name = "住所Dic" Then Exit For
Next DicSh
If DicSh Is Nothing Then MsgBox "住所Dicがありません": Exit Sub

Set DataSh = ThisWorkbook.Worksheets(1)
Set Ken_Ran = Range(DicSh.Range("A1"), DicSh.Range("A1").End(xlToRight))

Application.ScreenUpdating = False
For Each Tgt In Range(DataSh.Range("A1"), DataSh.Range("A65536").End(xlUp))
　　For Each R In Ken_Ran
　　　　If Tgt.Value Like R.Value & "*" Then
　　　　　　Ken = R.Value
　　　　　　Exit For
　　　　End If
　　Next R
　　If IsEmpty(R) = False Then
　　　　Set Sicho_Ran = Range(DicSh.Cells(2, R.Column), _
　　　　　DicSh.Cells(2, R.Column).End(xlDown))
　　　　For Each R In Sicho_Ran
　　　　　　If Tgt.Value Like Ken & R.Value & "*" Then
　　　　　　　　Sicho = R.Value
　　　　　　　　Wr = Array(Ken, Sicho, Mid(Tgt.Value, Len(Ken) + Len(Sicho) + 1))
　　　　　　　　Tgt.Offset(, 1).Resize(, 3) = Wr
　　　　　　　　Exit For
　　　　　　End If
　　　　Next R
　　End If
Next Tgt

Application.ScreenUpdating = True
Set Ken_Ran = Nothing
Set Sicho_Ran = Nothing
Set DicSh = Nothing
Set DataSh = Nothing
Erase Wr

MsgBox "終了"

End Sub

'Len_min～Len_max数で切り出しFindを繰り返して分割。
'県を省略しても分割されるが、県＋市が間違っていても分割される
'例）青森県横浜市港南区・・など
Sub Find_BUNKATU()

Dim Wr() As String '書き出し用Array
Dim Tgt As Range '対象セル
Dim Fi As Variant '検索
Dim Cnt, En, i As Integer '分割数,対象文字数,カウンタ
Dim buf, Ken, Sicho As String '一時文字列,県,市町村
Dim DataSh As Worksheet 'データSheet
Dim DicSh As Worksheet '辞書Sheet
Const Len_min As Integer = 2 '最小分割文字数例）港区,呉市
Const Len_max As Integer = 10 '最大分割文字数例)南都留郡富士河口湖町

For Each DicSh In ThisWorkbook.Worksheets
　　If DicSh.Name = "住所Dic" Then Exit For
Next DicSh
If DicSh Is Nothing Then MsgBox "住所Dicがありません": Exit Sub
Set DataSh = ThisWorkbook.Worksheets(1)

Application.ScreenUpdating = False
For Each Tgt In Range(DataSh.Range("A1"), DataSh.Range("A65536").End(xlUp))
　　ReDim Wr(2)
　　buf = Tgt.Value
　　For Cnt = 1 To 2
　　　　If Len(buf) > Len_max Then
　　　　　　En = Len_max
　　　　Else
　　　　　　En = Len(buf)
　　　　End If
　　　　For i = Len_min To En
　　　　　　Set Fi = DicSh.UsedRange.Find(Left(buf, i), , , xlWhole, , , False, False)
　　　　　　If Not Fi Is Nothing Then
　　　　　　　　If Fi.Row = 1 Then
　　　　　　　　　　Wr(0) = Fi.Value
　　　　　　　　Else
　　　　　　　　　　Wr(1) = Fi.Value
　　　　　　　　End If
　　　　　　　　buf = Mid(buf, i + 1)
　　　　　　　　Exit For
　　　　　　End If
　　　　Next i
　　Next Cnt
　　Wr(2) = buf
　　Tgt.Offset(, 1).Resize(, 3) = Wr
Next Tgt

Application.ScreenUpdating = True

Set DicSh = Nothing
Set DataSh = Nothing
Erase Wr

MsgBox "終了"

End Sub

'おまけ
Sub test()

Dim min, max As Integer
Dim minStr, maxStr As String
Dim R As Range
min = 3
For Each R In Worksheets("住所Dic").UsedRange
　　If min > Len(R.Value) And Len(R.Value) <> 0 Then min = Len(R.Value)
　　If max < Len(R.Value) Then max = Len(R.Value)
Next R

Debug.Print "min=" & min
Debug.Print "max=" & max

For Each R In Worksheets("住所Dic").UsedRange
　　If Len(R.Value) = min Then Debug.Print R.Value
　　If Len(R.Value) = max Then Debug.Print R.Value
Next R
End Sub


	【41273】Re:住所の分割方法

pi - 06/8/3(木) 16:07 -


	引用なし

	パスワード

みなさんありがとうございました。何とか出来そうです。


	【41278】Re:住所の分割方法

neptune - 06/8/3(木) 16:55 -


	引用なし

	パスワード

▼pi さん：
>みなさんありがとうございました。何とか出来そうです。
どんな方法で？
後の質問者の方の為に明らかにして欲しい。

私も参考にしたいですし。


	【41284】Re:住所の分割方法

ハチ - 06/8/3(木) 19:54 -


	引用なし

	パスワード

もう解決となっておりますが・・
なんとなく納得がいかず、さらにイヂっていました。
ファイルサイズもコンパクトになりました。

'郵政のKEN_ALL.CSVからWorkSheets("住所Dic")を生成する。
'_2では除外リストへ再整形
Sub Dic_Make_2()

Dim Ken, Sicho As String '県,市町村
Dim R, c As Long '書き出し用Row,Column
Dim buf As Variant　'一時的な配列
Dim myPath As String　'取り込みファイルPath
Dim CSVFile As String '取り込みファイル名
Dim FSO As Object 'Scripting.FileSystemObject
Dim Ws As Worksheet '対象WorkSheet
Dim min, max As Integer '分割文字文字列数
Dim Tgt As Range '対象セルループ用
Dim Str As String '切り出し文字列
Dim myDic As Object 'dictionary

myPath = ThisWorkbook.Path
CSVFile = "\KEN_ALL.CSV"
'取り込みファイルがあるか判定
If Dir(myPath & CSVFile) = "" Then
　　MsgBox CSVFile & "がありません": Exit Sub
End If
'WorkSheets("住所Dic")があるか判定。なければ作成
For Each Ws In ThisWorkbook.Worksheets
　　If Ws.Name = "住所Dic" Then
　　　　Ws.Cells.ClearContents
　　　　Exit For
　　End If
Next Ws
If Ws Is Nothing Then
　　With ThisWorkbook
　　　　Set Ws = .Worksheets.Add(After:=Worksheets(.Worksheets.Count))
　　　　Ws.Name = "住所Dic"
　　End With
End If

Set FSO = CreateObject("Scripting.FileSystemObject")

Application.ScreenUpdating = False
R = 0: c = 0
'県（列）市（行）で取り込み
With FSO.GetFile(myPath & CSVFile).OpenAsTextStream
　　Do Until .AtEndOfStream = True
　　　　buf = Split(.ReadLine, ",")
　　　　If Ken <> buf(6) Then
　　　　　　Ken = buf(6)
　　　　　　R = 1: c = c + 1
　　　　　　Ws.Cells(R, c).Value = Replace(Ken, """", "")
　　　　End If
　　　　
　　　　If Sicho <> buf(7) Then
　　　　　　Sicho = buf(7)
　　　　　　R = R + 1
　　　　　　Ws.Cells(R, c).Value = Replace(Sicho, """", "")
　　　　End If
　　Loop
　　.Close
End With
Set FSO = Nothing

'以下_2にて追加
'－－－－－－－
Set myDic = CreateObject("Scripting.dictionary")
min = 3
'取り込んだデータをループ　Tgt
For Each Tgt In Ws.UsedRange
　　'最小、最大文字数の作成
　　If min > Len(Tgt.Value) And Len(Tgt.Value) <> 0 Then min = Len(Tgt.Value)
　　If max < Len(Tgt.Value) Then max = Len(Tgt.Value)
　　'文字列途中に分割文字があるか判定
　　If Tgt.Value Like "*[都道府県区市町村]?*" Then
　　　　'あれば一文字ずらし分割して判定
　　　　For i = 2 To Len(Tgt.Value) - 1
　　　　　　Str = Left(Tgt.Value, i)
　　　　　　'分割文字列の位置であるか判定
　　　　　　If Str Like "*[都道府県区市町村]" Then
　　　　　　　　'重複の判定。.Add ～の値はなんでも良い
　　　　　　　　If myDic.Exists(Str) = False Then myDic.Add Str, 1
　　　　　　End If
　　　　Next i
　　End If
Next Tgt
'重複の無い文字列の取り出し
buf = myDic.Keys
'Wsのデータを削除し、取り出した文字列の書き込み
Ws.Cells.Delete
For i = 0 To UBound(buf)
　　Ws.Range("A1").Offset(i).Value = buf(i)
Next i

Application.ScreenUpdating = True
MsgBox "住所Dicが作成されました" & vbCr _
& "Macth_BUNKATU()内を" & vbCr _
& "Const Len_min As Integer = " & min & vbCr _
& "Const Len_max As Integer = " & max & vbCr _
& "に設定してください"

Set myDic = Nothing
Set Ws = Nothing
Erase buf
End Sub

'－－－－－－－－－－－－－
'分割文字列で判定。
'住所Dicを除外リストとして使用する。
Sub Macth_BUNKATU()

Dim Wr() As String '書き出し用Array
Dim Tgt As Range '対象セル
Dim Ma As Variant 'Macth用
Dim Cnt, En, i As Integer '分割数,対象文字数,カウンタ
Dim buf, Str As String '一時文字列,分割された文字列
Dim DataSh As Worksheet 'データSheet
Dim DicSh As Worksheet '辞書Sheet
Const Len_min As Integer = 2 '最小分割文字数例）港区,呉市
Const Len_max As Integer = 10 '最大分割文字数例)南都留郡富士河口湖町

'WorkSheets("住所Dic")があるか判定。なければ、Exit Sub
For Each DicSh In ThisWorkbook.Worksheets
　　If DicSh.Name = "Sheet3" Then Exit For
Next DicSh
If DicSh Is Nothing Then MsgBox "住所Dicがありません": Exit Sub
Set DataSh = ThisWorkbook.Worksheets(1)

Application.ScreenUpdating = False

'分割対象範囲をループ　Tgt
For Each Tgt In Range(DataSh.Range("A1"), DataSh.Range("A65536").End(xlUp))
　　'書き出し配列を初期化
　　ReDim Wr(2)
　　'対象セルの文字列を取得　buf
　　buf = Tgt.Value
　　'県、市、その後の分割用にループ2回 Cnt
　　For Cnt = 1 To 2
　　　　'最大分割数を下回った場合の処理。文字列分割ループ数をEnへ
　　　　If Len(buf) > Len_max Then
　　　　　　En = Len_max
　　　　Else
　　　　　　En = Len(buf)
　　　　End If
　　　　'分割文字数のループ i
　　　　For i = Len_min To En
　　　　　　'i文字分をStrへ
　　　　　　Str = Left(buf, i)
　　　　　　'区切り文字[都道府県区市町村]か判定
　　　　　　If Str Like "*[都道府県区市町村]" Then
　　　　　　　　'区切り文字であった場合、除外リストDicShにあるか判定
　　　　　　　　Ma = Application.Match(Str, DicSh.UsedRange, 0)
　　　　　　　　If IsError(Ma) = True Then
　　　　　　　　　　'県or市の判定。Falseなら市
　　　　　　　　　　If Str Like "*[都道府県]" Then
　　　　　　　　　　　　Wr(0) = Str
　　　　　　　　　　Else
　　　　　　　　　　　　Wr(1) = Str
　　　　　　　　　　End If
　　　　　　　　　　'buf文字列から切り出し分を削除
　　　　　　　　　　buf = Mid(buf, i + 1)
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　　　'県が省略されていた場合、Cntループは1回で終了
　　　　If Cnt = 1 And Wr(0) = "" Then Exit For
　　Next Cnt
　　'残り分を代入
　　Wr(2) = buf
　　'書き出し
　　Tgt.Offset(, 1).Resize(, 3) = Wr
Next Tgt

Application.ScreenUpdating = True

Set DicSh = Nothing
Set DataSh = Nothing
Erase Wr

MsgBox "終了"

End Sub


	【41289】Re:住所の分割方法

toshi - 06/8/3(木) 21:27 -


	引用なし

	パスワード

▼ハチさん：
ハチさんこんにちわ
いつも参考にさせていただいてます
利用方法の
説明お願いできませんか
Sub Macth_BUNKATU()を実行すると　エラー400がでてしまいます
よろしくお願いします。


	【41290】Re:住所の分割方法

neptune - 06/8/3(木) 22:38 -


	引用なし

	パスワード

▼toshi さん：
>▼ハチさん：
ではないですが、

>ハチさんこんにちわ
>いつも参考にさせていただいてます
>利用方法の
>説明お願いできませんか
>Sub Macth_BUNKATU()を実行すると　エラー400がでてしまいます
>よろしくお願いします。

どのように検証したのか書いてないのでわかりませんが、

条件１
同じフォルダにKen_All.csvを置く事
条件２
Macth_BUNKATU　を実行する前にDic_Make_2を実行しておく事。
条件３
シート名Sheet1～Sheet3のいずれかのA列１行目から下に分解したい
住所を入力しておく事。

以上が終わってからMacth_BUNKATUを実行する。

はちさんへ
ロジックは正直あまり検証はしてないんですが、Dic_Make_2の結果として
横浜市都
大阪市都
などが出てくるのは正常なんですか？
私も以前ずいぶん研究したんですが、地名が変わってしまったので
記憶が薄れてますので、？です。

私はDAO、ADOを使わずどの程度まで早くできるか試したかったので、
県毎、市毎などのIndexファイルを作り倒しました。
今は行方不明になってますけど ^ ^;;
結果、DAO、ADOには若干劣りますが、ストレスを感じない処理速度は
得られました。

結論としてはやっぱりDAO、ADOが早いし楽でした。^ ^;


	【41291】Re:住所の分割方法

漂流民 - 06/8/3(木) 23:22 -


	引用なし

	パスワード

▼pi さん：
こんばんわ

もう解決されている様なので今さらですが、
コードのみで分割するマクロを作ってみました。
単純なロジックで組んだので、メンテも楽かと・・・
（複雑なロジックを組む力がない？！）
単純な分、無駄に長いコードですが、ご参考までに。

Sub bun()
　 Dim i As Long, j As Long
　 Dim st As Long, stp As Long
　 Dim tx As String, ad As String

　 For i = 1 To Range("A65536").End(xlUp).Row
　　　tx = Cells(i, 1).Value
　　　st = 1

　　　If Left(tx, 3) = "東京都" Then
　　　　 Cells(i, 2).Value = Mid(tx, st, 3)
　　　　 st = 4
　　　Else
　　　　 For j = 1 To 4
　　　　　　ad = Mid(tx, j, 1)
　　　　　　Select Case ad
　　　　　　　 Case "道", "府", "県"
　　　　　　　　　Cells(i, 2).Value = Mid(tx, st, j)
　　　　　　　　　st = j + 1
　　　　　　　　　Exit For
　　　　　　End Select
　　　　 Next j
　　　End If

　　　stp = st
　　　If InStr(st, tx, "札幌市") > 0 Or InStr(st, tx, "仙台市") > 0 Or _
　　　　 InStr(st, tx, "千葉市") > 0 Or InStr(st, tx, "さいたま市") > 0 Or _
　　　　 InStr(st, tx, "横浜市") > 0 Or InStr(st, tx, "川崎市") > 0 Or _
　　　　 InStr(st, tx, "静岡市") > 0 Or InStr(st, tx, "名古屋市") > 0 Or _
　　　　 InStr(st, tx, "京都市") > 0 Or InStr(st, tx, "大阪市") > 0 Or _
　　　　 InStr(st, tx, "堺市") > 0 Or InStr(st, tx, "神戸市") > 0 Or _
　　　　 InStr(st, tx, "広島市") > 0 Or InStr(st, tx, "福岡市") > 0 Or _
　　　　 InStr(st, tx, "北九州市") > 0 Or InStr(st, tx, "四日市市") > 0 Or _
　　　　 InStr(st, tx, "市原市") > 0 Or InStr(st, tx, "市川市") > 0 Or _
　　　　 InStr(st, tx, "廿日市市") > 0 Or InStr(st, tx, "高市郡") > 0 Or _
　　　　 InStr(st, tx, "西八代郡市") > 0 Or InStr(st, tx, "神崎郡市") > 0 Or _
　　　　 InStr(st, tx, "中新川郡上市") > 0 Or InStr(st, tx, "石川郡野々市") > 0 Or _
　　　　 InStr(st, tx, "吉野郡下市") > 0 Or InStr(st, tx, "芳賀郡市") > 0 Or _
　　　　 InStr(st, tx, "余市郡") > 0 Then
　　　　　 stp = InStr(st, tx, "市") + 1
　　　End If
　　　If InStr(st, tx, "余市郡余市") > 0 Then
　　　　 stp = InStr(stp + 1, tx, "市") + 1
　　　End If
　　　If InStr(st, tx, "名古屋市中村") > 0 Then
　　　　 stp = InStr(stp + 1, tx, "村") + 1
　　　End If
　　　If InStr(st, tx, "北広島市") > 0 Or InStr(st, tx, "北名古屋市") > 0 Or _
　　　　 InStr(st, tx, "東大阪市") > 0 Or InStr(st, tx, "東広島市") > 0 Then
　　　　　 stp = st
　　　End If

　　　If InStr(st, tx, "町田市") > 0 Or InStr(st, tx, "大町市") > 0 Or _
　　　　 InStr(st, tx, "十日町市") > 0 Or InStr(st, tx, "杵島郡大町") > 0 Or _
　　　　 InStr(st, tx, "北松浦郡鹿町") > 0 Then
　　　　　 stp = InStr(st, tx, "町") + 1
　　　End If

　　　If InStr(st, tx, "村山市") > 0 Or InStr(st, tx, "武蔵村山市") > 0 Or _
　　　　 InStr(st, tx, "東村山市") > 0 Or InStr(st, tx, "羽村市") > 0 Or _
　　　　 InStr(st, tx, "大村市") > 0 Or InStr(st, tx, "田村市") > 0 Or _
　　　　 InStr(st, tx, "村上市") > 0 Or InStr(st, tx, "北村山郡") > 0 Or _
　　　　 InStr(st, tx, "東村山郡") > 0 Or InStr(st, tx, "西村山郡") > 0 Or _
　　　　 InStr(st, tx, "田村郡") > 0 Or InStr(st, tx, "佐波郡玉村") > 0 Or _
　　　　 InStr(st, tx, "柴田郡村田") > 0 Then
　　　　　 stp = InStr(st, tx, "村") + 1
　　　End If

　　　For j = stp To Len(tx)
　　　　 ad = Mid(tx, j, 1)
　　　　 Select Case ad
　　　　　　Case "市", "町", "村", "区"
　　　　　　　 Cells(i, 3).Value = Mid(tx, st, j - st + 1)
　　　　　　　 Cells(i, 4).Value = Right(tx, Len(tx) - j)
　　　　　　　 Exit For
　　　　 End Select
　　　Next j
　 Next i
End Sub

===================================================================================================
以下、メンテ用に作成手順です。

まず都道府県名と市区町村名を重複なしで読み込みます。
KEN_ALL.CSVと同じフォルダで下記コードを実行。
（２０００件ぐらいだと思います）

Sub csv_read()
　 Dim con As Object, rst As Object
　 Dim csc As String, csq As String, sht As String
　 Dim i As Long

　 Set con = CreateObject("ADODB.Connection")
　 Set rst = CreateObject("ADODB.Recordset")
　 csc = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & _
　　　　 ";Extended Properties=""text;HDR=NO;FMT=Delimited"""
　 csq = "Select Distinct F7,F8 From KEN_ALL.CSV"
　 con.Open csc
　 rst.Open csq, con

　 Application.ScreenUpdating = False
　 i = 1
　 Do Until rst.EOF
　　　Cells(i, 1).Value = rst.Fields(0)
　　　Cells(i, 2).Value = rst.Fields(1)
　　　rst.MoveNext
　　　i = i + 1
　 Loop
　 Columns("A:B").EntireColumn.AutoFit
　 Application.ScreenUpdating = True

　 rst.Close: Set rst = Nothing
　 con.Close: Set con = Nothing
End Sub

*************************************************************************************
考え方としては、市区町村名は全て"市"、 "町"、"村"、"区"のいずれかで必ず終わるので、
市区町村名で途中に"市"、 "町"、"村"、"区"を含むものを例外処理します。

とりあえず、下記コードで例外がどれぐらいあるかを確認。

Sub test1()
　 Dim i As Long, j As Long
　 Dim tx As String, ad As String
　 Columns("C:F").ClearContents

　 Application.ScreenUpdating = False
　 For i = 1 To Range("B65536").End(xlUp).Row
　　　tx = Cells(i, 2).Value

　　　For j = 1 To Len(tx)
　　　　 ad = Mid(tx, j, 1)
　　　　 Select Case ad
　　　　　　Case "市", "町", "村", "区"
　　　　　　　 Cells(i, 3).Value = Mid(tx, 1, j)
　　　　　　　 Exit For
　　　　 End Select
　　　Next j
　 Next i

　 Cells(1, 5).Value = "***例外***"
　 j = 2
　 For i = 1 To Range("B65536").End(xlUp).Row
　　　If Cells(i, 3).Value <> Cells(i, 2).Value Then
　　　　 Cells(j, 5).Value = Cells(i, 2).Value
　　　　 Cells(j, 6).Value = Cells(i, 3).Value
　　　　 j = j + 1
　　　End If
　 Next i

　 Columns("C:F").EntireColumn.AutoFit
　 Application.ScreenUpdating = True
End Sub

*************************************************************************************
Ｄ列（元データ）・Ｆ列（処理後データ）に例外が表示されたと思います。（１８０件ぐらい？）
これを見ると、「～市～区」のパターン（政令指定都市）が多いので、
その例外処理を組み込んだ下記コードを実行。

Sub test2()
　 Dim i As Long, j As Long
　 Dim st As Long, stp As Long
　 Dim tx As String, ad As String
　 Columns("C:F").ClearContents

　 Application.ScreenUpdating = False
　 For i = 1 To Range("B65536").End(xlUp).Row
　　　tx = Cells(i, 2).Value
　　　st = 1: stp = st

　　　If InStr(st, tx, "札幌市") > 0 Or InStr(st, tx, "仙台市") > 0 Or _
　　　　 InStr(st, tx, "千葉市") > 0 Or InStr(st, tx, "さいたま市") > 0 Or _
　　　　 InStr(st, tx, "横浜市") > 0 Or InStr(st, tx, "川崎市") > 0 Or _
　　　　 InStr(st, tx, "静岡市") > 0 Or InStr(st, tx, "名古屋市") > 0 Or _
　　　　 InStr(st, tx, "京都市") > 0 Or InStr(st, tx, "大阪市") > 0 Or _
　　　　 InStr(st, tx, "堺市") > 0 Or InStr(st, tx, "神戸市") > 0 Or _
　　　　 InStr(st, tx, "広島市") > 0 Or InStr(st, tx, "福岡市") > 0 Or _
　　　　 InStr(st, tx, "北九州市") > 0 Then
　　　　　 stp = InStr(1, tx, "市")
　　　End If

　　　For j = stp + 1 To Len(tx)
　　　　 ad = Mid(tx, j, 1)
　　　　 Select Case ad
　　　　　　Case "市", "町", "村", "区"
　　　　　　　 Cells(i, 3).Value = Mid(tx, st, j)
　　　　　　　 Exit For
　　　　 End Select
　　　Next j
　 Next i

　 Cells(1, 5).Value = "***例外***"
　 j = 2
　 For i = 1 To Range("B65536").End(xlUp).Row
　　　 If Cells(i, 3).Value <> Cells(i, 2).Value Then
　　　　　 Cells(j, 5).Value = Cells(i, 2).Value
　　　　　 Cells(j, 6).Value = Cells(i, 3).Value
　　　　　 j = j + 1
　　　 End If
　 Next i

　 Columns("C:F").EntireColumn.AutoFit
　 Application.ScreenUpdating = True
End Sub

それ以外の例外がＤ列（元データ）・Ｆ列（処理後データ）に表示されたと思います。（４０件ぐらい？）
あとは地道に例外処理を加え、都道府県・町域を処理すると、最初に提示したコードになります^^


	【41292】Re:住所の分割方法

ハチ - 06/8/3(木) 23:43 -


	引用なし

	パスワード

▼toshi さん：
こんばんは。
neptune さんの書いて頂いた方法でやってみてください。

▼neptune さん：
フォローありがとうございました＾＾

>ロジックは正直あまり検証はしてないんですが、Dic_Make_2の結果として
>横浜市都
>大阪市都
>などが出てくるのは正常なんですか？

横浜市都筑区
大阪市都島区
というのがあるようです。
[都道府県区市町村]
↑の文字列で区切り判定を入れているので
横浜市都　で切れないように除外リストに追加してます。

>私はDAO、ADOを使わずどの程度まで早くできるか試したかったので、
>県毎、市毎などのIndexファイルを作り倒しました。
>今は行方不明になってますけど ^ ^;;

41237で書いているほうの"住所Dic"では、
横軸に"県"、縦軸に"市"が並ぶように作成し
一応動作していたのですが、
地名の羅列を見ていたら、メラメラと統合したくなってきて・・・ｗ
一番動作が速そうなのは、Likeで→↓ループのようです。
どなたか大量の住所データを持っている　And　ヒマな方がいたら
検証してほしいとこです。

>結論としてはやっぱりDAO、ADOが早いし楽でした。^ ^;

やはりそうですよねぇ。
SQLをもっと勉強せねば！


	【41294】Re:住所の分割方法

toshi - 06/8/4(金) 0:00 -


	引用なし

	パスワード

▼neptuneさん：
▼ハチさん：
>条件１
>同じフォルダにKen_All.csvを置く事
>条件２
>Macth_BUNKATU　を実行する前にDic_Make_2を実行しておく事。
>条件３
>シート名Sheet1～Sheet3のいずれかのA列１行目から下に分解したい
>住所を入力しておく事。
>
>以上が終わってからMacth_BUNKATUを実行する。
返事ありがとうございます。
上記の通り実行したのですが
やはりerror400が出てしまいます
他に何か原因分かりますか？


	【41295】Re:住所の分割方法

toshi - 06/8/4(金) 0:50 -


	引用なし

	パスワード

▼toshi さん：
▼neptuneさん：
▼ハチさん：
>>条件１
>>同じフォルダにKen_All.csvを置く事
>>条件２
>>Macth_BUNKATU　を実行する前にDic_Make_2を実行しておく事。
>>条件３
>>シート名Sheet1～Sheet3のいずれかのA列１行目から下に分解したい
>>住所を入力しておく事。
>>
>>以上が終わってからMacth_BUNKATUを実行する。
>返事ありがとうございます。
>上記の通り実行したのですが
>やはりerror400が出てしまいます
>他に何か原因分かりますか？
ひとつ書き忘れました
エラー400が出るのはMacth_BUNKATU実行時です
1、2はうまくできてます。


	【41296】Re:住所の分割方法

toshi - 06/8/4(金) 1:31 -


	引用なし

	パスワード

お騒がせしました
新規bookを立ち上げ実行した結果
できました


	【41363】Re:住所の分割方法

ｍ2ｍ10 - 06/8/7(月) 15:06 -


	引用なし

	パスワード

>項目名[市区町村名]と[町域名]を参照住所が含むで
>SQLでつなげば、可能です。

と入れましたが、住所でした場合は
　条件により該当が2こ3こ出てきませんか？


	【41367】Re:住所の分割方法

neptune - 06/8/7(月) 18:35 -


	引用なし

	パスワード

▼ｍ2ｍ10 さん：
>>項目名[市区町村名]と[町域名]を参照住所が含むで
>>SQLでつなげば、可能です。
>
> と入れましたが、住所でした場合は
>　条件により該当が2こ3こ出てきませんか？
出てくるはずですよ。例えば大きなビルなどは階数別で複数のレコードに
分かれてますからね。


	【41372】Re:住所の分割方法

漂流民 - 06/8/7(月) 23:35 -


	引用なし

	パスワード

ミスですね。
>　　　If InStr(st, tx, "余市郡余市") > 0 Then
>　　　　 stp = InStr(stp + 1, tx, "市") + 1
　　　　 stp = InStr(stp, tx, "市") + 1
>　　　End If
>　　　If InStr(st, tx, "名古屋市中村") > 0 Then
>　　　　 stp = InStr(stp + 1, tx, "村") + 1
　　　　 stp = InStr(stp, tx, "村") + 1
>　　　End If
失礼しました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

7076 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free