Excel VBA質問箱 IV

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

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


7074 / 13644 ツリー ←次へ | 前へ→

【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:住所の分割方法 m2m10 06/8/1(火) 8:25 発言[未読]
【41201】Re:住所の分割方法 pi 06/8/1(火) 18:15 質問[未読]
【41225】Re:住所の分割方法 neptune 06/8/2(水) 14:17 回答[未読]
【41363】Re:住所の分割方法 m2m10 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:住所の分割方法 m2m10 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列に残りを入れたいと考えています。
シート関数ではなくマクロで行いたいと思っています。
この掲示板の過去ログで、郵便番号のCSVを利用すれば出来るようなことが書いてあったのですが、どのように活用すればいいのか見当がつきません。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=40597;id=excel
お力をお貸しください。よろしくお願いします。

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

引用なし
パスワード
   こんにちは。
郵便番号のCSVではありませんが、参考になりますでしょうか?

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

【41149】Re:住所の分割方法
発言  inoue E-MAILWEB  - 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:住所の分割方法
発言  m2m10  - 06/8/1(火) 8:25 -

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

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

引用なし
パスワード
   ▼ponpon さん:
>こんにちは。
>郵便番号のCSVではありませんが、参考になりますでしょうか?
>
>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 -

引用なし
パスワード
   ▼m2m10 さん:
>こんちは
> 全国一括のデータファイルをアクセスに取り込み
> 項目名[市区町村名]と[町域名]を参照住所が含むで
> 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 さん:
>▼m2m10 さん:
ではありませんけど、
 
>ありがとうございます。全国一括のデータファイルをアクセスに取り込むことは
>できたのですが、そこから先をどうしていいのか分かりません。
少しはやろうとしてみたんでしょうか?

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

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

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

【41227】Re:住所の分割方法
発言  m2m10  - 06/8/2(水) 15:04 -

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

条件列に 郵便番号 [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:住所の分割方法
回答  角田 WEB  - 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")を作ったあとに
分割するモジュールを2つ作ってみました

'郵政の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がでてしまいます
>よろしくお願いします。

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

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

以上が終わってから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と同じフォルダで下記コードを実行。
(2000件ぐらいだと思います)


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


*************************************************************************************
D列(元データ)・F列(処理後データ)に例外が表示されたと思います。(180件ぐらい?)
これを見ると、「〜市〜区」のパターン(政令指定都市)が多いので、
その例外処理を組み込んだ下記コードを実行。


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


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

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

引用なし
パスワード
   ▼toshi さん:
こんばんは。
neptune さんの書いて頂いた方法でやってみてください。

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

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

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

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

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

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

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

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

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

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

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

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

引用なし
パスワード
   お騒がせしました
新規bookを立ち上げ実行した結果
できました

【41363】Re:住所の分割方法
発言  m2m10  - 06/8/7(月) 15:06 -

引用なし
パスワード
   >項目名[市区町村名]と[町域名]を参照住所が含むで
>SQLでつなげば、可能です。

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

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

引用なし
パスワード
   ▼m2m10 さん:
>>項目名[市区町村名]と[町域名]を参照住所が含むで
>>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
失礼しました。

7074 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free