| |
▼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
それ以外の例外がＤ列（元データ）・Ｆ列（処理後データ）に表示されたと思います。（４０件ぐらい？）
あとは地道に例外処理を加え、都道府県・町域を処理すると、最初に提示したコードになります^^
|
|
漂流民
- 06/8/3(木) 23:22 -
