住所分割

http://q.hatena.ne.jp/1283352623

面白そうなので、VBAでZIPJISを使った住所分割をしてみる。
ZIPJISを解凍すると、ZIPJIS9B.K3というファイルがCSVのデータのようなので、
このファイルを実行させるエクセルファイルと同じ場所に置く。

次に以下のコードをコピペして実行。
アクティブなシートのA列に住所データが入っていれば分割される。
該当する住所が見つからない場合は、分割されないでB列とC列が空白なります。

Sub ZipSep()
    Dim FSO As Object
    Dim TS As Object
    Dim GYO As Long
    Dim strREC As String
    Dim h As Variant
    Dim i As Long
    Dim j As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim s1 As String
    Dim s2 As String
    Dim p1 As Integer
    
    Application.ScreenUpdating = False
    
    Set ws1 = ActiveSheet
    Set ws2 = Worksheets.Add
    
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set TS = FSO.OpenTextFile(ThisWorkbook.Path & "\ZIPJIS9B.k3", 1, False)
    Range("A:A").ClearContents
    h = Split(TS.ReadLine, ",")
    Cells(1, 1).Value = Replace(h(2), """", "")
    GYO = 2
    Do Until TS.AtEndOfStream
        h = Split(TS.ReadLine, ",")
        If UBound(h) > 1 Then
            If Cells(GYO - 1, 1).Value <> Replace(h(2), """", "") Then
                Cells(GYO, 1).Value = Replace(h(2), """", "")
                GYO = GYO + 1
            End If
        End If
    Loop
    
    TS.Close
    Set TS = Nothing
    Set FSO = Nothing

    ws1.Activate
    
    lastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lastRow1
        s1 = ws1.Cells(i, 1).Value
        For j = 1 To lastRow2
            s2 = ws2.Cells(j, 1).Value
            If Left(s1, Len(s2)) = s2 Then
                Select Case Left(s2, 3)
                    Case "東京都"
                        ws1.Cells(i, 1).Value = "東京都"
                    Case "大阪府"
                        ws1.Cells(i, 1).Value = "大阪府"
                    Case "京都府"
                        ws1.Cells(i, 1).Value = "京都府"
                    Case "北海道"
                        ws1.Cells(i, 1).Value = "北海道"
                    Case Else
                        p1 = InStr(1, s2, "県")
                        If p1 > 1 Then
                            ws1.Cells(i, 1).Value = Left(s2, p1)
                        Else
                            ws1.Cells(i, 1).Value = ""
                        End If
                End Select
                ws1.Cells(i, 2).Value = Replace(s2, ws1.Cells(i, 1).Value, "")
                ws1.Cells(i, 3).Value = Replace(s1, s2, "")
                Exit For
            End If
        Next j
    Next i
    
    Application.DisplayAlerts = False
    ws2.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

このZIPJISも都道府県は分割されていないので、コード中で分割する処理が必要となる。
また、正確に都道府県からの住所ならよいが、東京の人は区から書いたり、
大都市の人は普通に市から住所を書くことが多いと思う。
更にZIPJISは最新のデータであるが故に、昔の住所を使う人がいた場合はヒットしないことになる。
そこら辺までは不可能と言えば不可能か。