Excel VBA質問箱 IV

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

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


40538 / 76732 ←次へ | 前へ→

【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件ぐらい?)
あとは地道に例外処理を加え、都道府県・町域を処理すると、最初に提示したコードになります^^

0 hits

【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 発言

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