A’nocora　郵便番号データの住所入力データ化

VB2013で作成した、郵便番号データを住所録データとして使用する為の処理のスクリプトです。
詳しい説明は省略していますし、変数の一部をＰＵＢＬＩＣとして設定しているので、このまま使っても動きません。
MDB形式のデータベースを作成し、VB.NETのスクリプトでデータを加工しています。
アルゴリズムや、スクリプトの中身など拙いものですが、参考にして頂ける部分もあるかと思い公開しました。
同じような処理が延々と続きますので、どんなデータを加工しようとしているのか、なるべく明確にしながら記載しました。

新たな問題点や、対処法の検討、対処も行いますので、少しずつですが、変更点は修正していきます。
。
もし、どうしても動かしたい方、内容に疑問のある方は、ブログにコメントを頂ければ幸いです。 ACCESS VBAから移植の為、Dcountなど、関数を作っている部分もあります。
デバッグでの動作は確認していますが、ビルドしての動作は未確認です。

＊ZIPファイルの解凍にライブラリを使用していますので、.NET Framework 4.5以上が必要です。
＊リンクフリーです。
＊著作権も放棄します。
＊記載内容の不備、改良のご指摘は大歓迎です。サイクルメンテあのこら　南（tom@anocora.com）までご連絡下さい。
＊この記載によって、何らかの障害、損害が生じても、一切の責任は取りません。自己責任でご使用ください。
＊まだ未完成です。取り敢えず、スペースでの町域データ分離までは自信が持てるようになったので公開しました。
　今後、順次公開します。

処理の考え方

ここで作成しようとしている住所入力は、出張修理の為の、ご訪問先の入力です。

ご依頼をお受けする場合、ご住所の問いかけに対し、郵便番号からお答えいただくことは稀なケースになります。
ほとんどの方が、○○市□□町△△の××とお答えになりますので、電話で受け答えしながら、住所入力を完了したいのです。
受話器を持っているため、片手しか空いていません。

なるべく、簡単に入力するため、コンボでのデータ選択を基本の入力とします。
コンボの選択肢がすぐ見つけられるように10件前後の選択肢にしたいです。
その為に、都道府県、市町村、（区）、町域、補足になるべくデータを細分化します。

下記の処理の相当部分を処理されたデータを公開さ入れているサイトも有り、データはこちらからダウンロードできますが、市と区の分離、郡データの削除等、追加が必要なこともあり、全て自分で加工しました。

処理内容

手順	処理	ＣＳＶファイル
１	分割された町域データのマージ	Merge_Zip.CSV
２	町域に「以下に掲載がない場合」と記載されたレコード削除	Merge_Zip_1.CSV
３	(次のビルを除く)と「・階層不明」の文言の削除	Merge_Zip_2.CSV
４	「市区町村一円」の文言の削除	Merge_Zip_3.CSV
	町域補足項目への移動
	政令市の市と区の分離
	住所入力に不要な郡表記の削除
	「市区町村の次に番地がくる場合」の文言の（その他）への変更

町域にビル名が記載されたレコード削除

町域補足項目への移動
町域データを、読み仮名も含めて、町域、町域補足に分離
　・括弧で括られたデータの分離
　・町域内で複数回出現する地名とそれに続く地名データの分離

地名と思われる括弧内の”、”で区切られたデータを”、”でレコードに分離
京都の通り名など、不足している読み仮名の追記
町域のカナ表示をアルファベット２文字に置換(ヘボン式のローマ字表記ではなくローマ字カナ入力に置換）

課題

郵便番号データを住所入力で使おうとすると、いくつか課題が有ります。

郵便番号データは、住所に読み仮名データが付付与されており、カナ表記のカナ版とローマ字表記のローマ字版が有ります。
（カナ版は、促音・拗音を小書きで表示したものと小書きになっていないものがあります。）
カナ版は、市区、郡町村が分割されていませんが、ローマ字版では、○○市　□□区、○○郡　□□町のようにスペースで分割されていますので、ローマ字版を使うと、細分化が行いやすいです。

ローマ字版ですべてが対応できればいいのですが、多少課題が有ります。
・ローマ字版では、町域のデータが17文字でカットされて居て、マージをしても正しいデータになりません。
・ローマ字の表記がヘボン式の為、カナ入力でキーボードを打つ時と差異が出ます。
・ローマ字版と、カナ版では郵便番号データのレコード件数が異なります。
・住所データがスペースで区切られていても、読み仮名がスペースで区切られていないレコードが有ります。
・住所データがスペースで区切られていなくても、読み仮名がスペースで区切られているレコードが有ります。
＊カナ版とローマ字版では、データ件数も異なり、カナ版の方が正確なデータのようですので、ローマ字版は使いません。

Schema.ini

郵便番号データは、ヘッダー情報を持っていないので、項目名は適当に決めています。

別モジュールでの設定

anocora.mdbというデータベースを使っています。
スクリプト内のDB名をを適宜変更すれば、他のACCESS(jet)　DBで動きます。
処理するうえで、必須なテーブルがいくつかありますので、別途mdbデータとして、公開します。

DAOの参照設定

Access.DBを使っていることと、個人的な馴染みの問題で、DAOによるアクセスを使っています。
上記の参照設定が必要です。

ZIPの参照設定

下記の宣言に記載した
Imports System.IO
Imports System.IO.Compression
が必須です

ＰＵＢＬＩＣで宣言したDBE変数

db_path()

Dcount

Function Dcount(ByVal SearchFld As String, ByVal SearchTbl As String, ByVal SearchCriteria As String) As Object
        Dim r_Value As Object = DBNull.Value
        Dim dbcount As DAO.Database = DbE.OpenDatabase(db_path() + "\anocora.mdb")

If Microsoft.VisualBasic.Left(SearchFld, 1) = "[" Then
            SearchFld = Microsoft.VisualBasic.Right(SearchFld, Microsoft.VisualBasic.Len(SearchFld) - 1)
        End If
        If Microsoft.VisualBasic.Right(SearchFld, 1) = "]" Then
            SearchFld = Microsoft.VisualBasic.Left(SearchFld, Microsoft.VisualBasic.Len(SearchFld) - 1)
        End If

Dim rsCount As DAO.Recordset
        If SearchCriteria = "" Then
            rsCount = dbcount.OpenRecordset("SELECT Count( " & SearchFld & ") AS Count FROM " & SearchTbl & " ;", _
                                       DAO.RecordsetTypeEnum.dbOpenSnapshot)
        Else
            rsCount = dbcount.OpenRecordset("SELECT Count( " & SearchFld & ") AS Count FROM " & SearchTbl & " WHERE " & _
                                       SearchCriteria & ";", DAO.RecordsetTypeEnum.dbOpenSnapshot)
        End If
        Dcount = rsCount.Fields("count").Value

rsCount.Close() : rsCount = Nothing
        dbcount.Close() : dbcount = Nothing

End Function

DLookup

Function DLookup(ByVal SearchFld As String, ByVal SearchTbl As String, ByVal SearchCriteria As String) As Object
        Dim r_Value As Object = DBNull.Value

Dim dbLookup As DAO.Database = DbE.OpenDatabase(db_path() + "\anocora.mdb")
        If Microsoft.VisualBasic.Left(SearchFld, 1) = "[" Then
            SearchFld = Microsoft.VisualBasic.Right(SearchFld, Microsoft.VisualBasic.Len(SearchFld) - 1)
        End If
        If Microsoft.VisualBasic.Right(SearchFld, 1) = "]" Then
            SearchFld = Microsoft.VisualBasic.Left(SearchFld, Microsoft.VisualBasic.Len(SearchFld) - 1)
        End If

Dim rsLookup As DAO.Recordset = dbLookup.OpenRecordset("SELECT " & SearchFld & " FROM " & SearchTbl & " WHERE " _
                                                               & SearchCriteria & ";", DAO.RecordsetTypeEnum.dbOpenSnapshot)
        If rsLookup.RecordCount = 0 Then
            DLookup = Nothing
        Else
            DLookup = rsLookup.Fields(SearchFld).Value
        End If

rsLookup.Close() : rsLookup = Nothing
        dbLookup.Close() : dbLookup = Nothing

End Function

フォーム

こんなフォームを使っています。
見た目の問題で、一部配置を変えました。

フォームの詳細は、こちらに置きます。

変換テーブル

カナ→ローマ字変換通名の読み仮名補完に変換テーブルを使用しています。
mbdはこちら　anocora.mdb から取得してください。

スクリプト

宣言

メインスクリプト

Private Sub cmd_更新_Click(sender As Object, e As EventArgs) Handles cmd_更新.Click
        Dim strSQL As String

'Buttonを無効にする
        Me.cmd_更新.Enabled = False
        Me.cmd_終了.Enabled = False

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

Try 'プログラム異常停止時の対処用
            strSQL = "DROP TABLE R_住所;"
            db.Execute(strSQL)

strSQL = "DROP TABLE Del_住所;"
            db.Execute(strSQL)

Catch ex As Exception

End Try

strSQL = "DROP TABLE M_住所;"
        db.Execute(strSQL)

'カナ版データ用のテーブル作成
        strSQL = "Create Table M_住所 (ID Counter(1),郵便番号 text(12),都道府県 text(12),R_県 text(10),市区町村 text(12),"
        strSQL = strSQL & "R_市 text(64),区 text(12),R_区 text(32),町域 text(255),町域_16 text(24),R_町域 MEMO,地名 text(255),"
        strSQL = strSQL & "R_地名 MEMO,註釈 text(255),R_註釈 text(255),公共団体コード text(12),旧番号 text(12),小字 text(2),"
        strSQL = strSQL & "町域分割 text(2),丁目 text(2),統合 text(2),更新 text(2),理由 text(2));"
        db.Execute(strSQL)

'ローマ字版データ用のテーブル作成
        strSQL = "Create Table R_住所 (ID Counter(1),郵便番号 text(12),都道府県 text(12),RR_県 text(10),市区町村 text(12),"
        strSQL = strSQL & "RR_市 text(63),町域 text(255),RR_町域 text(255));"
        db.Execute(strSQL)

'Del_住所（マージ済みデータ削除用）を作成します。
        strSQL = "CREATE TABLE Del_住所 (ID number, 郵便番号 TEXT(10), 町域 TEXT(255));"
        db.Execute(strSQL)

db.Close() : db = Nothing

'住所データのダウンロード
        Label1.Text = "ダウンロードを開始しました。"
        Application.DoEvents()

Call NewData() 'ダウンロード、解凍’

Call データ整形()

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

db.Close() : db = Nothing

'Buttonを有効に戻す
        Me.cmd_更新.Enabled = True
        Me.cmd_終了.Enabled = True

End Sub

郵便番号データのダウンロードと解凍処理

Public Sub NewData()
        Dim extractPath As String = "D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release"

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")
        Dim p_pref As String  'ダウンロード元
        Dim strSQL As String

'カーソルを待機カーソルに変更
        Me.Cursor = Cursors.WaitCursor

'カナデータダウンロード開始
        Me.Label1.Text = "カナデータをダウンロード中です。"
        Application.DoEvents()

p_pref = Me.TextBox1.Text
        Try
            Dim wc As New System.Net.WebClient()
            wc.DownloadFile(p_pref, "D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release\ken_all.zip")
            wc.Dispose()

Catch ex As Exception
            Me.Label1.Text = "ダウンロードエラー" & vbCrLf & p_pref & vbCrLf & "の存在を確認してください。"
        End Try

'ファイルの解凍
        Dim zipPath2 As String = "D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release\ken_all.zip"

'古いファイルの削除
        If System.IO.File.Exists(extractPath & "\KEN_ALL.CSV") = True Then

System.IO.File.Delete(extractPath & "\KEN_ALL.CSV")

End If

ZipFile.ExtractToDirectory(zipPath2, extractPath)

'テーブル更新
        Me.Label1.Text = "カナデータをテーブルに取り込み中です。"
        Application.DoEvents()

strSQL = "INSERT INTO M_住所 SELECT * "
        strSQL = strSQL & "FROM [Text;Database=D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release].[KEN_ALL.csv];"
        db.Execute(strSQL)
        Me.Label1.Text = "カナデータの取り込み完了しました。"
        Application.DoEvents()

'カーソルを元に戻す
        Me.Cursor = Cursors.Default

'カーソルを待機カーソルに変更
        Me.Cursor = Cursors.WaitCursor

'ローマ字データダウンロード開始
        Me.Label1.Text = "ローマ字データをダウンロード中です。"
        Application.DoEvents()

p_pref = Me.TextBox2.Text
        Try
            Dim wc As New System.Net.WebClient()
            wc.DownloadFile(p_pref, "D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release\ken_all_rome.zip")
            wc.Dispose()

Catch ex As Exception
            Me.Label1.Text = "ダウンロードエラー" & vbCrLf & p_pref & vbCrLf & "の存在を確認してください。"
        End Try

'ファイルの解凍
        Dim zipPath As String = "D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release\ken_all_rome.zip"

'古いディレクトリの削除
        If System.IO.Directory.Exists(extractPath & "\ken_all_rome") = True Then System.IO.Directory.Delete(extractPath & _
            "\ken_all_rome", True)

'古いファイルの削除
        If System.IO.File.Exists(extractPath & "\ken_all_rome.csv") = True Then System.IO.File.Delete(extractPath & _
            "\ken_all_rome.csv")

ZipFile.ExtractToDirectory(zipPath, extractPath)

'ファイルの移動
        System.IO.File.Copy("D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release\ken_all_rome\KEN_ALL_ROME.csv" _
                            , "D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release\KEN_ALL_ROME.csv", True)

'テーブル更新
        Me.Label1.Text = "ローマ字データをテーブルに取り込み中です。"
        Application.DoEvents()

'カーソルを待機カーソルに変更
        Me.Cursor = Cursors.WaitCursor

strSQL = "INSERT INTO  R_住所 SELECT * "
        strSQL = strSQL & "FROM [Text;Database=D:\VB自転車店統合管理\自転車店統合管理\WindowsApplication1\bin\Release]"
        strSQL = strSQL & ".[KEN_ALL_ROME.csv];"
        db.Execute(strSQL)
        Me.Label1.Text = "ローマ字データの取り込み完了しました。"
        Application.DoEvents()

'カーソルを元に戻す
        Me.Cursor = Cursors.Default

db.Close() : db = Nothing

End Sub

データの整形処理（未検証です）
　町域不要データ処理
　カナマージ処理
　町域スペース分離
　地名括弧分離
　町域括弧分離
　町域括弧内分割
　同一郵便番号分離
　地名_丁目番地分離
　通り名ブランク修正
　市区分離
　郡削除
　カナ_町域の整形
　カナ_県の整形

Private Sub データ整形()
        Dim strSQL As String

Call 町域不要データ処理()

Call カナマージ処理()

Call 分離テーブル準備()

Call 町域スペース分離() 'スペースで区切られた町域データ(ローマ字版）を地名に移動

Call 地名括弧分離() 'スペース分離で地名に移動したデータの（）内処理

Call 町域括弧分離() '町域の（）内のデータを地名に移動

Call 町域括弧内分割() '町域の（）内のデータを個別レコードに分解

'Call 同一郵便番号分離()

Call 通り名ブランク修正()

Call 市区分離()

Call 郡削除()

'＊＊カナ_アルファベット置変処理
        Call カナ_町域の整形()

Call カナ_県の整形()

Call カナ_市の整形()

Call カナ_区の整形()

'カナ_アルファベット変換中間テーブル作成クエリ
        strSQL = "SELECT M_住所.R_町域, R_住所.RR_町域 INTO KANA_W "
        strSQL = strSQL & "FROM M_住所 LEFT JOIN R_住所 ON (M_住所.郵便番号 = R_住所.郵便番号) AND (M_住所.町域 = R_住所.町域置換) "
        strSQL = strSQL & "WHERE (((M_住所.郵便番号)<>'5810027') AND ((M_住所.郵便番号)<>'6730012') AND ((R_住所.RR_町域) Is Not Null));"
        Debug.Print(strSQL)
        db.Execute(strSQL)
        Label1.Text = "中間テーブル作成を終了しました。。"
        Application.DoEvents()

'＊カナ町域ヘボン式の修正
        '撥音（ン）修正クエリ
        strSQL = "DELETE KANA_W.*, KANA_W.RR_町域, KANA_W.R_町域 "
        strSQL = strSQL & "FROM KANA_W "
        strSQL = strSQL & "WHERE (((KANA_W.RR_町域)='AM') AND ((KANA_W.R_町域)='ｱﾝ')) OR (((KANA_W.RR_町域)='IM') AND ((KANA_W.R_町域)='ｲﾝ')) OR (((KANA_W.RR_町域)='UM') AND ((KANA_W.R_町域)='ｳﾝ')) OR (((KANA_W.RR_町域)='EM') AND ((KANA_W.R_町域)='ｴﾝ')) OR (((KANA_W.RR_町域)='OM') AND ((KANA_W.R_町域)='ｵﾝ'));"
        Debug.Print(strSQL)
        db.Execute(strSQL)

'長音（ｵｳ）修正クエリ
        strSQL = "UPDATE KANA_W SET KANA_W.RR_町域 = 'OU' "
        strSQL = strSQL & "WHERE (((KANA_W.R_町域)='ｵｳ'));"
        Debug.Print(strSQL)
        db.Execute(strSQL)

'長音（ｵｵ）修正クエリ
        strSQL = "UPDATE KANA_W SET KANA_W.RR_町域 = 'OO' "
        strSQL = strSQL & "WHERE (((KANA_W.R_町域)='ｵｵ'));"
        Debug.Print(strSQL)
        db.Execute(strSQL)

'ア行で始まり、2文字目に促音が入るデータの更新
        strSQL = "UPDATE KANA_W SET KANA_W.R_町域 = left([R_町域],1)& 'ｰ' "
        strSQL = strSQL & "WHERE (((Asc([R_町域]))>'176' And (Asc([R_町域]))<'182') AND ((Mid([R_町域],2,1))='ｰ'));"
        db.Execute(strSQL)

'単一化テーブル作成クエリ
        strSQL = "SELECT KANA_W.RR_町域,KANA_W.R_町域 INTO カナ変換テーブル "
        strSQL = strSQL & "FROM KANA_W "
        strSQL = strSQL & "GROUP BY KANA_W.RR_町域, KANA_W.R_町域;"
        Debug.Print(strSQL)
        db.Execute(strSQL)
        Label1.Text = "ヘボン式の修正処理を終了しました。。"
        Application.DoEvents()

'変換処理R_県
        strSQL = "UPDATE カナ変換テーブル RIGHT JOIN M_住所 ON カナ変換テーブル.R_町域 = M_住所.R_県 SET M_住所.R_県 = [カナ変換テーブル]![RR_町域];"
        Debug.Print(strSQL)
        db.Execute(strSQL)
        Label1.Text = "【都道府県】カナ_アルファベット変換処理を終了しました。。"
        Application.DoEvents()

'変換処理R_市
        strSQL = "UPDATE カナ変換テーブル RIGHT JOIN M_住所 ON カナ変換テーブル.R_町域 = M_住所.R_市 SET M_住所.R_市 = [カナ変換テーブル]![RR_町域];"
        db.Execute(strSQL)
        Label1.Text = "【市町村】カナ_アルファベット変換処理を終了しました。。"
        Application.DoEvents()

'変換処理R_区
        strSQL = "UPDATE カナ変換テーブル RIGHT JOIN M_住所 ON カナ変換テーブル.R_町域 = M_住所.R_区 SET M_住所.R_区 = [カナ変換テーブル]![RR_町域];"
        db.Execute(strSQL)
        Label1.Text = "【市町村】カナ_アルファベット変換処理を終了しました。。"
        Application.DoEvents()

'変換処理R_町域
        strSQL = "UPDATE カナ変換テーブル RIGHT JOIN M_住所 ON カナ変換テーブル.R_町域 = M_住所.R_町域 SET M_住所.R_町域 = [カナ変換テーブル]![RR_町域];"
        Debug.Print(strSQL)
        db.Execute(strSQL)
        Label1.Text = "【町域】カナ_アルファベット変換処理を終了しました。。"
        Application.DoEvents()

'変換処理R_地名
        strSQL = "UPDATE カナ変換テーブル RIGHT JOIN M_住所 ON カナ変換テーブル.R_町域 = M_住所.R_地名 SET M_住所.R_町域 = [カナ変換テーブル]![RR_町域];"
        Debug.Print(strSQL)
        db.Execute(strSQL)
        Label1.Text = "【町域】カナ_アルファベット変換処理を終了しました。。"
        Application.DoEvents()

'町域地名分離処理
        '分離処理
        strSQL = "UPDATE R_住所 RIGHT JOIN M_住所 ON R_住所.町域置換 = M_住所.町域 SET M_住所.町域 = Left([R_住所]![町域],InStr([R_住所]![町域],'　')-1), M_住所.地名 = Mid([R_住所]![町域],InStr([R_住所]![町域],'　')+1) "
        strSQL = strSQL & "WHERE (((R_住所.町域) Like '*　*'));"
        db.Execute(strSQL)
        Label1.Text = "町域地名分離処理を終了しました。。"
        Application.DoEvents()

'カーソルを元に戻す
        Me.Cursor = Cursors.Default

'strSQL = "DROP TABLE 市区変換テーブル;"
        'db.Execute(strSQL)

'strSQL = "DROP TABLE 郡変換テーブル;"
        'db.Execute(strSQL)

'strSQL = "DROP TABLE KANA_W;"
        'db.Execute(strSQL)

'strSQL = "DROP TABLE カナ変換テーブル;"
        'db.Execute(strSQL)

'strSQL = "DROP TABLE W_区カナ ;"
        'db.Execute(strSQL)

db.Close() : db = Nothing

End Sub

町域不要データ処理

対象データ

Private Sub 町域不要データ処理()
        Dim strSQL As String

'カーソルを待機カーソルに変更
        Me.Cursor = Cursors.WaitCursor

'不要データ削除_1　開始
        Me.Label1.Text = "不要データを削除中です。"
        Application.DoEvents()

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'＊＊削除する郵便番号データ
        '以下に掲載がない場合、階層不明）、*階）
        strSQL = "DELETE M_住所.* "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE [町域]='以下に掲載がない場合' OR [町域] Like '*階層不明）' OR [町域] Like '*階）';"
        db.Execute(strSQL)

'＊＊不要な町域データをブランクにする
        '（次のビルを除く）
        strSQL = "UPDATE M_住所 "
        strSQL = strSQL & "SET [町域] = Left([町域],InStr([町域],'（次のビルを除く）')-1)"
        strSQL = strSQL & ", [R_町域] = Left([R_町域],InStr([R_町域],'(ﾂｷﾞﾉﾋﾞﾙｦﾉｿﾞｸ)')-1)"
        strSQL = strSQL & "WHERE [町域] Like '*（次のビルを除く）*';"
        db.Execute(strSQL)

'＊＊不要な町域データを註釈に移動する
        '*の次に番地がくる場合、町域名称以外の一円を註釈に移動
        strSQL = "UPDATE M_住所 "
        strSQL = strSQL & "SET [町域] = '', [R_町域] = '', [註釈] = [町域], [R_註釈] = [R_町域] "
        strSQL = strSQL & "WHERE [町域] Like '*の次に番地がくる場合' Or ([町域] Like '*一円' AND [町域]<>'一円');"
        db.Execute(strSQL)

'不要データ削除_1　終了
        Me.Label1.Text = "初回の不要データ削除と移動が終了しました。"
        Application.DoEvents()
        db.Close() : db = Nothing

End Sub

カナマージ処理

対象データ

Private Sub カナマージ処理() '分割レコードのマージ処理
        Dim strSQL As String

Label1.Text = "カナテーブルのマージ処理を開始しました。。"
        Application.DoEvents()

'カーソルを待機カーソルに変更
        Me.Cursor = Cursors.WaitCursor

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")
        '重複した郵便番号を持つレコードの抽出
        strSQL = "SELECT  M_住所.[ID],M_住所.[郵便番号], M_住所.[町域], M_住所.[R_町域] "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE (((M_住所.[郵便番号])"
        strSQL = strSQL & " In (SELECT [郵便番号] FROM [M_住所] As Tmp GROUP BY [郵便番号] HAVING Count(*)>1 ))) "
        strSQL = strSQL & "ORDER BY M_住所.[ID];"

rs = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

'マージ処理
        Dim Rm As Integer = 0

While rs.EOF = False
            '開始"("が有って、終了")"が無いデータの抽出。
            If rs.Fields("町域").Value.IndexOf("（") > 0 And rs.Fields("町域").Value.IndexOf("）") = -1 Then

'開始"("が有って、終了")"が無いデータの郵便番号
                Dim y_id As String = rs.Fields("郵便番号").Value.ToString

'最初の分割されたデータ取得
                Dim t_marge As String = rs.Fields("町域").Value
                '最初の分割されたR_町域データ取得
                Dim r_marge As String = rs.Fields("R_町域").Value

'続いて同じ郵便番号を持つデーターの抽出
                Do
                    If rs.EOF = False Then
                        rs.MoveNext()
                    Else
                        Exit Do
                    End If

'郵便番号の一致確認
                    If rs.Fields("郵便番号").Value.ToString <> y_id Then Exit Do

'分割されたデータのマージ処理
                    t_marge = t_marge & rs.Fields("町域").Value

'分割されたR_町域データのマージ処理
                    If r_marge <> rs.Fields("R_町域").Value Then r_marge = r_marge & rs.Fields("R_町域").Value

'削除対象レコードの記録処理
                    strSQL = "INSERT INTO Del_住所 (ID,郵便番号,町域) VALUES('" & rs.Fields!ID.Value & "'"
                    strSQL = strSQL & ",'" & rs.Fields!郵便番号.Value & "','" & rs.Fields!町域.Value & "');"
                    db.Execute(strSQL)

'分割されたデータのレコード数を取得
                    Rm = Rm + 1

'終了")"を見つけたらループを終了
                    If rs.Fields("町域").Value.IndexOf("）") > 0 Then Exit Do
                Loop

'開始"("が有るレコードに戻る。
                rs.Move(-Rm)

'町域データを更新する。
                rs.Edit()
                rs.Fields("町域").Value = t_marge
                rs.Fields("R_町域").Value = r_marge
                rs.Update()

'元のレコードに移動する。
                rs.Move(Rm)

'分割されたレコード数の変数をクリア
                Rm = 0
            End If

rs.MoveNext()
        End While

rs.Close() : rs = Nothing
        Label1.Text = "カナテーブルのマージ処理を終了しました。。"
        Application.DoEvents()

'マージ済みレコードを削除する。
        strSQL = "DELETE M_住所.* FROM M_住所 RIGHT JOIN Del_住所 ON M_住所.ID = Del_住所.ID;"
        db.Execute(strSQL)

Label1.Text = "マージ済みのレコードを削除しました。。"
        Application.DoEvents()

strSQL = "DROP TABLE Del_住所;"
        db.Execute(strSQL)

db.Close() : db = Nothing

End Sub

町域データと読み仮名をスペースを基に町域と地名に分離

対象データ

町域がスペースで区切られたデータ

括弧の前に付いたスペースの除去

読み仮名がスペースで区切られていないデータ。
Private Sub 町域不要データ処理() Dim strSQL As String 'カーソルを待機カーソルに変更 Me.Cursor = Cursors.WaitCursor '不要データ削除_1　開始 Me.Label1.Text = "不要データを削除中です。" Application.DoEvents() db = DbE.OpenDatabase(db_path() + "\anocora.mdb") '＊＊削除する郵便番号データ '以下に掲載がない場合、階層不明）、*階） strSQL = "DELETE M_住所.* " strSQL = strSQL & "FROM M_住所 " strSQL = strSQL & "WHERE [町域]='以下に掲載がない場合' OR [町域] Like '*階層不明）' OR [町域] Like '*階）';" db.Execute(strSQL) '＊＊不要な町域データをブランクにする '（次のビルを除く） strSQL = "UPDATE M_住所 " strSQL = strSQL & "SET [町域] = Left([町域],InStr([町域],'（次のビルを除く）')-1)" strSQL = strSQL & ", [R_町域] = Left([R_町域],InStr([R_町域],'(ﾂｷﾞﾉﾋﾞﾙｦﾉｿﾞｸ)')-1)" strSQL = strSQL & "WHERE [町域] Like '*（次のビルを除く）*';" db.Execute(strSQL) '＊＊不要な町域データを註釈に移動する '*の次に番地がくる場合、町域名称以外の一円を註釈に移動 strSQL = "UPDATE M_住所 " strSQL = strSQL & "SET [町域] = '', [R_町域] = '', [註釈] = [町域], [R_註釈] = [R_町域] " strSQL = strSQL & "WHERE [町域] Like '*の次に番地がくる場合' Or ([町域] Like '*一円' AND [町域]<>'一円');" db.Execute(strSQL) '不要データ削除_1　終了 Me.Label1.Text = "初回の不要データ削除と移動が終了しました。" Application.DoEvents() db.Close() : db = Nothing End Sub
読み仮名のみスペースで区切られたデータ

スペースで重複して区切られたデータ

町域データをスペース位置で、町域と地名に分割します。
スペースが複数ある時は、更に地名と註釈に分割します。

Private Sub 分離テーブル準備()
        Dim strSQL As String

Label1.Text = "データの分離用テーブル作成中です。"

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'町域がスペースで区切られ、RR_町域データもスペースで区切られたデータ
        strSQL = "SELECT [市区町村],[町域],[RR_町域],'' AS 町域置換,'' AS 町域分割,'' AS RR_町域分割,"
        strSQL = strSQL & " '' AS R_町域,'' AS 地名,'' AS RR_地名, '' AS R_地名 , '' AS 註釈 , '' AS RR_註釈 , '' AS R_註釈 "
        strSQL = strSQL & "INTO 町域地名分離変換 "
        strSQL = strSQL & "FROM R_住所 "
        strSQL = strSQL & "WHERE [町域] Like '*　*' AND [RR_町域] Like '* *';"
        db.Execute(strSQL)

'町域がスペースで区切られ、RR_町域データはスペースで区切られていないデータ
        strSQL = "INSERT INTO 町域地名分離変換 ( 市区町村,町域,RR_町域) "
        strSQL = strSQL & "SELECT [市区町村],[町域],[RR_町域] "
        strSQL = strSQL & "FROM R_住所 "
        strSQL = strSQL & "WHERE [町域] Like '*　*' AND [RR_町域] Not Like '* *';"
        db.Execute(strSQL)

'町域はスペースで区切られていないが、RR_町域がスペースで区切られたデータ
        strSQL = "INSERT INTO 町域地名分離変換 ( 市区町村,町域,RR_町域) "
        strSQL = strSQL & "SELECT [市区町村],[町域],[RR_町域] "
        strSQL = strSQL & "FROM R_住所 "
        strSQL = strSQL & "WHERE [町域] Not Like '* *' AND [RR_町域] Like '* *';"
        db.Execute(strSQL)

'スペースなしの町域データを作成
        strSQL = "UPDATE 町域地名分離変換 SET 町域地名分離変換.町域置換 = IIf(InStr([町域],'　')>0"
        strSQL = strSQL & ",Left([町域],InStr([町域],'　')-1) & Mid([町域],InStr([町域],'　')+1),Left([町域],16)) "
        db.Execute(strSQL)

'町域がスペースで区切られた住所データの分離処理
        strSQL = "UPDATE 町域地名分離変換 SET [町域分割] = Left([町域],InStr([町域],'　')-1) "
        strSQL = strSQL & ", [地名] = Mid([町域],InStr([町域],'　')+1) "
        strSQL = strSQL & "WHERE [町域] Like '*　*';"
        db.Execute(strSQL)

'RR_町域がスペースで区切られた読み仮名データの分離処理
        strSQL = "UPDATE 町域地名分離変換 SET [RR_町域分割] = Left([RR_町域],InStr([RR_町域],' ')-1)"
        strSQL = strSQL & ", [RR_地名] = Mid([RR_町域],InStr([RR_町域],' ')+1)"
        strSQL = strSQL & "WHERE [RR_町域] Like '* *';"
        db.Execute(strSQL)

'データの区切りが"（"で共通する読み仮名の分割
        strSQL = "UPDATE 町域地名分離変換 SET [RR_町域分割] = Left([RR_町域],InStr([RR_町域],'(')-1)"
        strSQL = strSQL & ", [RR_地名] = Mid([RR_町域],InStr([RR_町域],'(')) "
        strSQL = strSQL & "WHERE [地名] Like '（*' AND [RR_町域] Like '*(*' AND [RR_町域分割] Is Null;"
        db.Execute(strSQL)

'データの区切りが"（"で共通する町域の分割
        strSQL = "UPDATE 町域地名分離変換 SET [町域分割] = Left([町域],InStr([町域],'(')-1), [地名] = Mid([町域],InStr([町域],'(')) "
        strSQL = strSQL & "WHERE [RR_地名] Like '(*' AND [町域分割] Is Null;"
        db.Execute(strSQL)

'町域が重複したスペースを持つデータの処理
        '   スペースなしの町域置換データを作成
        strSQL = "UPDATE 町域地名分離変換 SET 町域地名分離変換.町域置換 = IIf(InStr([町域置換],'　')>0"
        strSQL = strSQL & ",Left([町域置換],InStr([町域置換],'　')-1) & Mid([町域置換],InStr([町域置換],'　')+1))"
        strSQL = strSQL & "WHERE (((町域地名分離変換.町域置換) Like '*　*'));"
        db.Execute(strSQL)

'   地名がスペースで区切られ、RR_地名データもスペースで区切られたデータの分離処理
        strSQL = "UPDATE 町域地名分離変換 SET [地名] = Left([地名],InStr([地名],'　')-1) "
        strSQL = strSQL & ", [RR_地名] = Left([RR_地名],InStr([RR_地名],' ')-1)"
        strSQL = strSQL & ", [註釈] = Mid([地名],InStr([地名],'　')+1) "
        strSQL = strSQL & ", [RR_註釈] = Mid([RR_地名],InStr([RR_地名],' ')+1)"
        strSQL = strSQL & "WHERE [地名] Like '*　*' AND [RR_地名] Like '* *';"
        db.Execute(strSQL)

'   スペースなしの市区町村データを作成
        strSQL = "UPDATE 町域地名分離変換 SET 町域地名分離変換.市区町村 = IIf(InStr([市区町村],'　')>0"
        strSQL = strSQL & ",Left([市区町村],InStr([市区町村],'　')-1) & Mid([市区町村],InStr([市区町村],'　')+1))"
        strSQL = strSQL & "WHERE (((町域地名分離変換.市区町村) Like '*　*'));"
        db.Execute(strSQL)

'カーソルを待機カーソルに変更
        ProgressBar2.Visible = False
        Me.Cursor = Cursors.WaitCursor

Call 町域分割処理() '町域が分割されていないデータで共通する町域が２レコード以上あるデータの分離処理

Call R_町域分割処理() 'R_町域（読み仮名）が分割されていないデータで共通するR_町域（読み仮名）が２レコード以上あるデータの分離処理

Label1.Text = "分離用テーブル作成準備が完了しました。"
        Application.DoEvents()

End Sub

Private Sub 町域分割処理()
        Dim mati_chi As String

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'町域の更新対象抽出
        Dim 町域SQL As String = "SELECT [市区町村],[町域],[RR_町域],[RR_町域分割] "
        町域SQL = 町域SQL & "FROM 町域地名分離変換 "
        町域SQL = 町域SQL & "WHERE [町域分割] Is Null AND [RR_町域] Like '* *';"
        rs = db.OpenRecordset(町域SQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

rs.MoveLast()
        rs.MoveFirst()

'progressBarコントロールを初期化する
        ProgressBar2.Visible = True
        ProgressBar2.Minimum = 0
        ProgressBar2.Maximum = rs.RecordCount
        ProgressBar2.Value = 0

Dim r_c As Integer
        Dim i As Integer
        Dim rc_cmp As Boolean 'レコード処理終了フラグ

'RR_町域分割の文字列から町域の共通文字列を抽出
        While rs.EOF = False
            If Dcount("町域分割", "町域地名分離変換", "RR_町域='" & rs.Fields!RR_町域.Value & "'") = 0 Then '更新済みをスルー

rc_cmp = False

Dim strSQL2 As String = "SELECT [町域],[RR_町域] "
                strSQL2 = strSQL2 & "FROM R_住所 "
                strSQL2 = strSQL2 & "GROUP BY [町域],[RR_町域], Len([町域]) "
                If Dcount("町域", "R_住所", "RR_町域 Like '" & rs.Fields!RR_町域分割.Value & "*' and 町域 like '" & _
                        rs.Fields!町域.Value.Substring(0, 2) & "*' and 町域 <> '" & rs.Fields!町域.Value & " '") > 0 Then
                    strSQL2 = strSQL2 & "HAVING  [RR_町域] Like '" & rs.Fields!RR_町域分割.Value & "*' and [町域] like '" & _
                    rs.Fields!町域.Value.Substring(0, 2) & "*' and [町域] <> '" & rs.Fields!町域.Value & " '"
                Else
                    strSQL2 = strSQL2 & "HAVING [RR_町域] Like '" & rs.Fields!RR_町域分割.Value & "*' and [町域] like '" & _
                        rs.Fields!町域.Value.Substring(0, 1) & "*' and [町域] <> '" & rs.Fields!町域.Value & " '"
                End If
                strSQL2 = strSQL2 & " ORDER BY Len([町域]);"

Dim rs2 As DAO.Recordset = db.OpenRecordset(strSQL2, DAO.RecordsetTypeEnum.dbOpenDynaset)

If rs2.RecordCount > 0 Then
                    rs2.MoveFirst()
                    Dim t As Integer = Len(rs2.Fields!町域.Value) + 1
                    Dim srchi As String = rs2.Fields!町域.Value
                    Dim srchi_sub As String = ""

If Dcount("町域", "R_住所", "RR_町域 Like '" & rs.Fields!RR_町域分割.Value & "*' and 町域 like '" & _
                              rs.Fields!町域.Value.Substring(0, 2) & "*' and 町域 <> '" & rs.Fields!町域.Value & " '") > 0 Then
                        i = 3
                        mati_chi = srchi.Substring(0, 2)
                    Else
                        i = 2
                        mati_chi = srchi.Substring(0, 1)
                    End If

Do Until i > t '先頭レコードと次のレコードの町域のデータを3文字目から1文字づつ比較。
                        rs2.MoveFirst()

If Len(srchi) > i - 1 Then
                            srchi_sub = srchi.Substring(i - 1, 1).ToString
                        Else
                            srchi_sub = ""
                        End If

mati_chi = mati_chi & srchi_sub

Dim s As Integer = 1

While rs2.EOF = False And s < 5
                            If rs.Fields!町域.Value.Substring _
                                 (0, IIf(Len(rs.Fields!町域.Value) > i - 1, i, Len(rs.Fields!町域.Value))) <> mati_chi Or _
                                  srchi_sub = "　" Or srchi_sub = "" Then '差異が発生したしたら、データの更新をしてループから出る。
                                mati_chi = mati_chi.Substring(0, i - 1)

Dim strSQL3 As String = "UPDATE 町域地名分離変換 SET [町域分割] ='" & mati_chi & "'"
                                strSQL3 = strSQL3 & ", [地名] =Mid([町域],len('" & mati_chi & "')+1) "
                                strSQL3 = strSQL3 & "WHERE [RR_町域分割]='" & rs.Fields!RR_町域分割.Value & "'"
                                strSQL3 = strSQL3 & " and [町域置換] like '" & rs.Fields!町域.Value.Substring(0, 2) & "*'"
                                strSQL3 = strSQL3 & " and [市区町村] = '" & rs.Fields!市区町村.Value & "' AND [地名] Is Null;"
                                db.Execute(strSQL3)

rc_cmp = True '処理済み

Exit While
                            End If

rs2.MoveNext()
                            s = s + 1
                        End While

If rc_cmp = True Then Exit Do
                        i = i + 1
                    Loop

End If

rs2.Close() : rs2 = Nothing
            End If

rs.MoveNext()

'ProgressBar2の値を変更する
            r_c = r_c + 1

'Label1のテキストを変更する
            ProgressBar2.Value = r_c
            Label1.Text = "スペース区切り町域データの分離中です。" & r_c.ToString() & "/" & ProgressBar2.Maximum
            Application.DoEvents()
        End While

'カーソルを待機カーソルに変更
        ProgressBar2.Visible = False
        Me.Cursor = Cursors.WaitCursor

rs.Close() : rs = Nothing
        db.Close() : db = Nothing

End Sub

Private Sub R_町域分割処理()
        Dim R_mati_chi As String
        Dim R_chimei As String
        Dim retry As Boolean

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'RR_町域の更新対象抽出
        Dim R_町域SQL As String = "SELECT [市区町村], [町域],[RR_町域],[町域分割],[RR_町域分割],[地名],[RR_地名] "
        R_町域SQL = R_町域SQL & "FROM 町域地名分離変換 "
        R_町域SQL = R_町域SQL & "WHERE [RR_町域分割] Is Null AND [町域] Like '* *';"

rs = db.OpenRecordset(R_町域SQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

rs.MoveLast()
        rs.MoveFirst()

'progressBarコントロールを初期化する
        ProgressBar2.Visible = True
        ProgressBar2.Minimum = 0
        ProgressBar2.Maximum = rs.RecordCount
        ProgressBar2.Value = 0

Dim r_c As Integer

'RR_町域分割の文字列から町域の共通文字列を抽出
        While rs.EOF = False
            If Dcount("RR_町域", "町域地名分離変換", "町域分割='" & rs.Fields!町域分割.Value & _
                      "' AND RR_町域分割 <>'' AND [RR_町域] Not Like '* *'") = 0 Then '更新済みをスルー

If Dcount("RR_町域", "町域地名分離変換", "RR_町域 Like '* *' And (町域 Like '" _
                                                  & rs.Fields!町域分割.Value & " *'Or 町域='" & rs.Fields!町域分割.Value & "')") _
                        > 0 And retry = False Then '別レコードが、対象の町域と同じ読みを持ち、読みがスペースで区切られている場合

R_mati_chi = DLookup("RR_町域", "町域地名分離変換", "RR_町域 Like '* *' And (町域 Like '" _
                                              & rs.Fields!町域分割.Value & " *'Or 町域='" & rs.Fields!町域分割.Value & "')")
                    R_mati_chi = Trim(R_mati_chi.Substring(0, InStr(R_mati_chi, " ")))
                    R_chimei = Trim(rs.Fields!RR_町域.Value.Substring(Len(R_mati_chi)))

If InStr(rs.Fields!RR_町域.Value, R_mati_chi) = 0 Then '読み仮名が対象に含まれない場合、地名での分離を再試行する
                        rs.MovePrevious()
                        r_c = r_c - 1
                        retry = True
                    End If
                Else
                    retry = False
                    R_chimei = DLookup("RR_町域", "町域地名分離変換", "(地名 ='" & rs.Fields!地名.Value & "' OR (地名 Like '*" _
                                                  & rs.Fields!地名.Value & " ' AND RR_町域 Like '* *')) AND RR_町域 Like '*" _
                                                  & rs.Fields!RR_町域.Value.Substring(rs.Fields!RR_町域.Value.Length - 4) & "'")
                    R_chimei = Trim(R_chimei.Substring(InStr(R_chimei, " ")))
                    R_mati_chi = Trim(rs.Fields!RR_町域.Value.Substring(0, InStr(rs.Fields!RR_町域.Value, R_chimei) - 1))
                End If

If retry = False Then
                    Dim strSQL3 As String = "UPDATE 町域地名分離変換 SET [RR_町域分割] ='" & R_mati_chi & "'"
                    strSQL3 = strSQL3 & ", [RR_地名] =mid([RR_町域],len('" & R_mati_chi & "')+1) "
                    strSQL3 = strSQL3 & "WHERE [町域] Like '*　*' AND [RR_町域] Not Like '* *'"
                    strSQL3 = strSQL3 & " AND [RR_町域] Like '" & R_mati_chi & "*';"
                    db.Execute(strSQL3)
                End If
            End If
            rs.MoveNext()

'ProgressBar2の値を変更する
            r_c = r_c + 1
            ProgressBar2.Value = r_c
            Label1.Text = "町域読み仮名データの分離中です。" & r_c.ToString() & "/" & ProgressBar2.Maximum
            Application.DoEvents()
        End While

'カーソルを待機カーソルに変更
        ProgressBar2.Visible = False
        Me.Cursor = Cursors.WaitCursor

rs.Close() : rs = Nothing
        db.Close() : db = Nothing

End Sub

読み仮名データ（カナ表記）を取得して、町域と地名に分割後、変換テーブルの内容をM_住所に反映します。
複数のスペースで地名と註釈に分離されたデータは、読み仮名の分離処理も行います。

Private Sub 町域スペース分離()
        Dim strSQL As String

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'16文字でカットした町域データ作成
        strSQL = "UPDATE M_住所 SET M_住所.町域_16 = Left([町域],16);" '町域地名分離変換の町域置換との連結用"
        db.Execute(strSQL)

'町域分離変換テーブル読み仮名更新
        strSQL = "UPDATE M_住所 INNER JOIN 町域地名分離変換 ON (M_住所.市区町村 = 町域地名分離変換.市区町村) "
        strSQL = strSQL & "AND (M_住所.町域_16 = 町域地名分離変換.町域置換) "
        strSQL = strSQL & "SET 町域地名分離変換.R_町域 = [M_住所]![R_町域];"
        db.Execute(strSQL)

Call 町域カナ分離() 'R_住所のスペース区切りと一致する町域読み仮名位置の取得

Call 地名カナ分離() 'R_住所のスペース区切りと一致する地名読み仮名位置の取得

Label1.Text = "町域地名分離変換テーブルに地名のカナ表記を追加しました。"
        Application.DoEvents()

'分離処理
        db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'町域地名分離の更新
        strSQL = "UPDATE 町域地名分離変換 INNER JOIN M_住所 ON 町域地名分離変換.町域置換 = M_住所.町域_16 "
        strSQL = strSQL & "SET M_住所.町域 = [町域地名分離変換]![町域分割], M_住所.R_町域 = [町域地名分離変換]![R_町域]"
        strSQL = strSQL & ", M_住所.地名 = [町域地名分離変換]![地名], M_住所.R_地名 = [町域地名分離変換]![R_地名]"
        strSQL = strSQL & ", M_住所.註釈 = [町域地名分離変換]![註釈], M_住所.R_註釈 = [町域地名分離変換]![R_註釈];"
        db.Execute(strSQL)
        Label1.Text = "スペース区切り町域地名分離処理を終了しました。"
        Application.DoEvents()

strSQL = "DROP TABLE 町域地名分離変換;"
        db.Execute(strSQL)

db.Close() : db = Nothing

End Sub

Private Sub 町域カナ分離()
        Dim strSQL As String
        db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

strSQL = "SELECT [RR_町域分割], Count(*) AS cnt "
        strSQL = strSQL & "FROM 町域地名分離変換 "
        strSQL = strSQL & "GROUP BY [RR_町域分割] "
        strSQL = strSQL & "HAVING (((Count(*))>0)) "
        strSQL = strSQL & "ORDER BY Count(*) DESC; "
        Dim rs As DAO.Recordset = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

'progressBarコントロールを初期化する
        ProgressBar2.Visible = True
        ProgressBar2.Minimum = 0
        ProgressBar2.Maximum = rs.RecordCount
        ProgressBar2.Value = 0
        Dim r_c As Integer

'R_町域の文字列から町域の共通文字列を抽出
        While rs.EOF = False

Dim str_kana As String = DLookup("R_町域", "町域地名分離変換", _
                                             "RR_町域分割='" & rs.Fields!RR_町域分割.Value & "' AND R_町域 <> ''")
            Dim l As Integer = Len(str_kana)
            Dim sp_kana As String = ""
            Dim i As Integer = 1

Do
                If Dcount("ローマ", "5文字変換", "ｶﾅ='" & Mid(str_kana, i, 5) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "5文字変換", "ｶﾅ='" & Mid(str_kana, i, 5) & "'")
                    i = i + 5
                ElseIf Dcount("ローマ", "4文字変換", "ｶﾅ='" & Mid(str_kana, i, 4) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "4文字変換", "ｶﾅ='" & Mid(str_kana, i, 4) & "'")
                    i = i + 4
                ElseIf Dcount("ローマ", "3文字変換", "ｶﾅ='" & Mid(str_kana, i, 3) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "3文字変換", "ｶﾅ='" & Mid(str_kana, i, 3) & "'")
                    i = i + 3
                ElseIf Dcount("ローマ", "2文字変換", "ｶﾅ='" & Mid(str_kana, i, 2) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "2文字変換", "ｶﾅ='" & Mid(str_kana, i, 2) & "'")
                    i = i + 2
                ElseIf Dcount("ローマ", "1文字変換", "ｶﾅ='" & Mid(str_kana, i, 1) & "'") > 0 Then
                    If Mid(str_kana, i, 1) = "ﾝ" Then
                        If Mid(rs.Fields!RR_町域分割.Value, Len(sp_kana) + 1, 1) = "P" _
                            Or Mid(rs.Fields!RR_町域分割.Value, Len(sp_kana) + 1, 1) = "B" _
                            Or Mid(rs.Fields!RR_町域分割.Value, Len(sp_kana) + 1, 1) = "M" Then
                            sp_kana = sp_kana & "M"
                        Else
                            sp_kana = sp_kana & "N"
                        End If
                    ElseIf Mid(str_kana, i, 1) = "ｯ" Then
                        sp_kana = sp_kana & Mid(rs.Fields!RR_町域分割.Value, Len(sp_kana) + 1, 1)
                    Else
                        sp_kana = sp_kana & DLookup("ローマ", "1文字変換", "ｶﾅ='" & Mid(str_kana, i, 1) & "'")
                    End If
                    i = i + 1
                End If
                If sp_kana = rs.Fields!RR_町域分割.Value Then
                    Dim strSQL2 As String = "UPDATE 町域地名分離変換 "
                    strSQL2 = strSQL2 & "SET [R_町域] = Left([R_町域]," & i - 1 & "),[R_地名] = Mid([R_町域]," & i & ") "
                    strSQL2 = strSQL2 & "WHERE [RR_町域分割]='" & rs.Fields!RR_町域分割.Value & "';"
                    db.Execute(strSQL2)

Exit Do
                End If
            Loop Until i > l

rs.MoveNext()

'ProgressBar2の値を変更する
            r_c = r_c + 1

'Label1のテキストを変更する
            If r_c Mod 50 = 0 Or ProgressBar2.Maximum - r_c < 50 Then
                ProgressBar2.Value = r_c
                Label1.Text = "町域カナデータ分離処理中です。" & r_c.ToString() & "/" & ProgressBar2.Maximum
                Application.DoEvents()
            End If

End While

'カーソルを待機カーソルに変更
        ProgressBar2.Visible = False
        Me.Cursor = Cursors.WaitCursor

rs.Close() : rs = Nothing
        db.Close() : db = Nothing

End Sub

Private Sub 地名カナ分離()
        Dim strSQL As String
        db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

strSQL = "SELECT 町域地名分離変換.[RR_地名], Count(*) AS cnt "
        strSQL = strSQL & "FROM 町域地名分離変換 "
        strSQL = strSQL & "WHERE(((町域地名分離変換.註釈) <> '')) "
        strSQL = strSQL & "GROUP BY 町域地名分離変換.[RR_地名] "
        strSQL = strSQL & "HAVING (((Count(*))>0)) "
        strSQL = strSQL & "ORDER BY Count(*) DESC; "
        Dim rs As DAO.Recordset = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

'R_町域の文字列から町域の共通文字列を抽出
        While rs.EOF = False

Dim str_kana As String = DLookup("R_地名", "町域地名分離変換", _
                                             "RR_地名='" & rs.Fields!RR_地名.Value & "' AND R_地名 <> ''")
            Dim l As Integer = Len(str_kana)
            Dim sp_kana As String = ""
            Dim i As Integer = 1

Do
                If Dcount("ローマ", "5文字変換", "ｶﾅ='" & Mid(str_kana, i, 5) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "5文字変換", "ｶﾅ='" & Mid(str_kana, i, 5) & "'")
                    i = i + 5
                ElseIf Dcount("ローマ", "4文字変換", "ｶﾅ='" & Mid(str_kana, i, 4) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "4文字変換", "ｶﾅ='" & Mid(str_kana, i, 4) & "'")
                    i = i + 4
                ElseIf Dcount("ローマ", "3文字変換", "ｶﾅ='" & Mid(str_kana, i, 3) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "3文字変換", "ｶﾅ='" & Mid(str_kana, i, 3) & "'")
                    i = i + 3
                ElseIf Dcount("ローマ", "2文字変換", "ｶﾅ='" & Mid(str_kana, i, 2) & "'") > 0 Then
                    sp_kana = sp_kana & DLookup("ローマ", "2文字変換", "ｶﾅ='" & Mid(str_kana, i, 2) & "'")
                    i = i + 2
                ElseIf Dcount("ローマ", "1文字変換", "ｶﾅ='" & Mid(str_kana, i, 1) & "'") > 0 Then
                    If Mid(str_kana, i, 1) = "ﾝ" Then
                        If Mid(rs.Fields!RR_地名.Value, Len(sp_kana) + 1, 1) = "P" _
                            Or Mid(rs.Fields!RR_地名.Value, Len(sp_kana) + 1, 1) = "B" _
                            Or Mid(rs.Fields!RR_地名.Value, Len(sp_kana) + 1, 1) = "M" Then
                            sp_kana = sp_kana & "M"
                        Else
                            sp_kana = sp_kana & "N"
                        End If
                    ElseIf Mid(str_kana, i, 1) = "ｯ" Then
                        sp_kana = sp_kana & Mid(rs.Fields!RR_地名.Value, Len(sp_kana) + 1, 1)
                    Else
                        sp_kana = sp_kana & DLookup("ローマ", "1文字変換", "ｶﾅ='" & Mid(str_kana, i, 1) & "'")
                    End If
                    i = i + 1
                End If
                If sp_kana = rs.Fields!RR_地名.Value Then
                    Dim strSQL2 As String = "UPDATE 町域地名分離変換 "
                    strSQL2 = strSQL2 & "SET [R_地名] = Left([R_地名]," & i - 1 & "),[R_註釈] = Mid([R_地名]," & i & ") "
                    strSQL2 = strSQL2 & "WHERE [RR_地名]='" & rs.Fields!RR_地名.Value & "';"
                    db.Execute(strSQL2)

Exit Do
                End If
            Loop Until i > l

rs.MoveNext()

'ProgressBar2の値を変更する
            r_c = r_c + 1
            'ProgressBar2.Value = r_c

'Label1のテキストを変更する
            If r_c Mod 50 = 0 Or ProgressBar2.Maximum - r_c < 50 Then
                ProgressBar2.Value = r_c
                Label1.Text = "地名カナデータ分離処理中です。" & r_c.ToString() & "/" & ProgressBar2.Maximum
                Application.DoEvents()
            End If

End While

'カーソルを待機カーソルに変更
        ProgressBar2.Visible = False
        Me.Cursor = Cursors.WaitCursor

rs.Close() : rs = Nothing
        db.Close() : db = Nothing

End Sub

括弧内の地名とは関わらないデータを註釈に移動

対象データ

町域に残った括弧内のデータ

(その他),(丁目),(番地),(番地のみ),(大字),(大字、番地),(無番地),(無番地を除く),(全域)または(各町)の記載

地名に続く括弧内データ

丁目、番地以外の文字列を含まない（）内のデータ

Private Sub 地名括弧分離() 'スペース分離で地名に移動したデータの（）内処理
        Dim strSQL As String

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'町域に残った、括弧内データを地名に移動
        strSQL = "UPDATE M_住所 SET "
        strSQL = strSQL & "[町域] = Left([町域],InStr([町域],'（')-1)"
        strSQL = strSQL & ", [R_町域] = IIf(InStr([R_町域],'(')>0,Left([R_町域],InStr([R_町域],'(')-1),[R_町域])"
        strSQL = strSQL & ", [地名] = Mid([町域],InStr([町域],'('))"
        strSQL = strSQL & ",[R_地名] = IIf(InStr([R_町域],'(')>0,Mid([R_町域],InStr([R_町域],'(')),'') "
        strSQL = strSQL & "WHERE [町域] Like '*（*'"
        db.Execute(strSQL)

'(その他),(丁目),(番地),(番地のみ),(大字),(大字、番地),(無番地),(無番地を除く),(全域)または(各町)の記載を註釈に移動
        strSQL = "UPDATE M_住所 SET [地名] = Left([地名],InStr([地名],'（')-1), [R_地名] = Left([R_地名],InStr([R_地名],'(')-1)"
        strSQL = strSQL & ", [註釈] = Mid([地名],InStr([地名],'（'))"
        strSQL = strSQL & ", [R_註釈] = Mid([R_地名],InStr([R_地名],'(')) "
        strSQL = strSQL & "WHERE [地名] Like '*（その他）' Or [地名] Like '*（丁目）' Or [地名] Like '*（番地）'"
        strSQL = strSQL & " Or [地名] Like '*（番地のみ）' Or [地名] Like '*（大字）' Or [地名] Like '*（大字、番地）'"
        strSQL = strSQL & " Or [地名] Like '*（無番地）' Or [地名] Like '*（無番地を除く）' Or [地名] Like '*（全域）'"
        strSQL = strSQL & " Or [地名] Like '*（各町）';"
        db.Execute(strSQL)

'地名に続く括弧内データを註釈に移動
        strSQL = "UPDATE M_住所 SET "
        strSQL = strSQL & "[地名] = Left([地名],InStr([地名],'（')-1)"
        strSQL = strSQL & ", [R_地名] = IIf(InStr([R_地名],'(')>0,Left([R_地名],InStr([R_地名],'(')-1),[R_地名])"
        strSQL = strSQL & ", [註釈] = Mid([地名],InStr([地名],'('))"
        strSQL = strSQL & ", [R_註釈] = IIf(InStr([R_地名],'(')>0,Mid([R_地名],InStr([R_地名],'(')),'') "
        strSQL = strSQL & "WHERE [地名] Like '*?（*';"
        db.Execute(strSQL)

'丁目、番地以外の文字列を含まない（）内のデータを註釈に移動
        '　移動対象のデータの抽出
        strSQL = "SELECT [地名], [R_地名], [註釈], [R_註釈] "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE [地名]<>'' And ([地名] Like '*丁目*)' Or [地名] Like '*番地)' Or [地名] Like '*以外)' "
        strSQL = strSQL & "Or [地名] Like '*以上)' Or [地名] Like '*以下)'  Or [地名] Like '*以降）' Or [地名] Like '*以内）'"
        strSQL = strSQL & "Or [地名] Like '*#）' Or [地名] Like '*～*）' Or [地名] Like '*－*）');"

Dim rs As DAO.Recordset = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

While rs.EOF = False
            '数値化できるかチェック
            Dim t_change As String = rs.Fields!地名.Value

t_change = Replace(t_change, "丁目", "")
            t_change = Replace(t_change, "番地", "")
            t_change = Replace(t_change, "以外", "")
            t_change = Replace(t_change, "以上", "")
            t_change = Replace(t_change, "以下", "")
            t_change = Replace(t_change, "～", "")
            t_change = Replace(t_change, "－", "")
            t_change = Replace(t_change, "の", "")
            t_change = Replace(t_change, "、", "")
            t_change = Replace(t_change, "（", "")
            t_change = Replace(t_change, "）", "")
            t_change = StrConv(t_change, VbStrConv.Narrow)
            Dim i As Boolean
            Dim per As Integer = Int(Len(t_change) / 28)
            Dim per_mod As Integer = Len(t_change) Mod 28
            Dim n As Integer
            Dim Deci As Boolean = True

If per > 0 Then
                For n = 0 To per
                    If n = per Then
                        If Decimal.TryParse(t_change.Substring(28 * n, per_mod), i) = False Then
                            Deci = False
                            Exit For
                        End If
                    Else
                        If Decimal.TryParse(t_change.Substring(28 * n, 28), i) = False Then
                            Deci = False
                            Exit For
                        End If
                    End If
                Next
            Else
                If Decimal.TryParse(t_change, i) = False Then
                    Deci = False
                End If
            End If

If Deci = True Then '数値化できたデータだけを移動
                rs.Edit()
                rs.Fields!R_註釈.Value = rs.Fields!R_地名.Value
                rs.Fields!R_地名.Value = ""
                rs.Fields!註釈.Value = rs.Fields!地名.Value
                rs.Fields!地名.Value = ""
                rs.Update()
            End If
            rs.MoveNext()
        End While

rs.Close() : rs = Nothing
        db.Close() : db = Nothing

End Sub

括弧内の”、”で区切られたデータを”、”でレコードに分離

対象データ

Private Sub 地名括弧内分割()
        Dim strSQL As String

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'地名データのみ分割する為、括弧内の数字の後の"、"を"，"に変える。
        strSQL = "SELECT M_住所.* "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE (M_住所.地名) Like '*#、*' And (M_住所.地名) Like '*「*';"
        rs = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset) '

While rs.EOF = False
            Dim tch() As String = Split(rs.Fields!地名.Value, "「")
            Dim R_tch() As String = Split(rs.Fields!R_地名.Value, "<")
            Dim t As Integer = tch.Length - 1 '地名の配列数
            Dim i As Integer = 0
            Dim t_change As String = ""
            Dim r_change As String = ""

For i = 0 To t
                If i = 0 Then
                    t_change = tch(i) & "「"
                    r_change = R_tch(i) & "<"
                ElseIf i < t Then
                    Dim tch_s() As String = Split(tch(i), "」")
                    Dim R_tch_s() As String = Split(R_tch(i), ">")
                    tch(i) = Replace(tch_s(0), "、", "，") & "」" & tch_s(1)
                    R_tch(i) = Replace(R_tch_s(0), "､", ",") & ">" & R_tch_s(1)
                    t_change = t_change & tch(i) & "「"
                    r_change = r_change & R_tch(i) & "<"

Else
                    Dim tch_s() As String = Split(tch(i), "」")
                    Dim R_tch_s() As String = Split(R_tch(i), ">")
                    tch(i) = Replace(tch_s(0), "、", "，") & "」" & tch_s(1)
                    R_tch(i) = Replace(R_tch_s(0), "､", ",") & ">" & R_tch_s(1)
                    t_change = t_change & tch(i)
                    r_change = r_change & R_tch(i)
                End If
            Next
            rs.Edit()
            rs.Fields("地名").Value = t_change
            rs.Fields("R_地名").Value = r_change
            rs.Update()
            rs.MoveNext()

'Label1のテキストを変更する
            Label1.Text = "括弧内の数字の後の'、’を'，'に変更中です。"
            Application.DoEvents()

End While
        rs.Close() : rs = Nothing

'"、"で区切られた町域（地名）データの分離
        strSQL = "SELECT M_住所.* "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE (M_住所.地名) Like '*、*' ;"
        rs = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

rs.MoveLast()
        rs.MoveFirst()

While rs.EOF = False
            '地名データの'、'での分離、R_地名は'､'
            Dim tch() As String = Split(rs.Fields!地名.Value, "、")
            Dim R_tch() As String = Split(rs.Fields!R_地名.Value, "､")
            Dim t As Integer = tch.Length '地名の配列数
            Dim r As Integer = R_tch.Length  'R_地名の配列数
            Dim f As Integer = If(t > r, t, If(t = r, t, r))
            Dim i As Integer = 0
            Dim ri As Integer
            Dim ti As Integer

For i = 0 To f - 1
                ri = If(i > r - 1, r - 1, i)
                ti = If(i > t - 1, t - 1, i)

If r = 1 Then
                    If i = 0 Then '町域（地名）の既存データ更新
                        strSQL = "UPDATE M_住所 SET [地名] ='" & tch(ti) & ")' "
                        strSQL = strSQL & "WHERE [ID]=" & rs.Fields!ID.Value & ";"
                    ElseIf i = f - 1 Then '最後の分割追加
                        strSQL = "INSERT INTO  M_住所 (郵便番号,都道府県,R_県,市区町村,R_市,町域,R_町域,地名) "
                        strSQL = strSQL & "VALUES('" & rs.Fields!郵便番号.Value & "','" & rs.Fields!都道府県.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_県.Value & "','" & rs.Fields!市区町村.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_市.Value & "','" & rs.Fields!町域.Value & "',"

If InStr(tch(0), "（第") > 0 And InStr(tch(1), "第") = 0 Then
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（第" & tch(ti) & "');"
                        Else
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（" & tch(ti) & "');"
                        End If
                    Else '町域の分割追加
                        strSQL = "INSERT INTO  M_住所 (郵便番号,都道府県,R_県,市区町村,R_市,町域,R_町域,地名) "
                        strSQL = strSQL & "VALUES('" & rs.Fields!郵便番号.Value & "','" & rs.Fields!都道府県.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_県.Value & "','" & rs.Fields!市区町村.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_市.Value & "','" & rs.Fields!町域.Value & "',"
                        If InStr(tch(0), "（第") > 0 And InStr(tch(1), "第") = 0 Then
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（第" & tch(ti) & "）');"
                        Else
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（" & tch(ti) & "）');"
                        End If
                    End If
                    db.Execute(strSQL)
                Else
                    If i = 0 Then '町域（地名）の分割更新
                        strSQL = "UPDATE M_住所 SET [地名] ='" & tch(ti) & "）', [R_地名] = '" & R_tch(ri) & ")' "
                        strSQL = strSQL & "WHERE [ID]=" & rs.Fields!ID.Value & ";"
                    ElseIf ri = f - 1 Then '最後の分割追加
                        strSQL = "INSERT INTO  M_住所 (郵便番号,都道府県,R_県,市区町村,R_市,町域,R_町域,地名,R_地名) "
                        strSQL = strSQL & "VALUES('" & rs.Fields!郵便番号.Value & "','" & rs.Fields!都道府県.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_県.Value & "','" & rs.Fields!市区町村.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_市.Value & "','" & rs.Fields!町域.Value & "',"
                        If InStr(tch(0), "（第") > 0 And InStr(tch(1), "第") = 0 Then
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（第" & tch(ti) & "','(ﾀﾞｲ" & R_tch(ri) & "');"
                        Else
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（" & tch(ti) & "','(" & R_tch(ri) & "');"
                        End If
                    Else '町域の分割追加
                        strSQL = "INSERT INTO  M_住所 (郵便番号,都道府県,R_県,市区町村,R_市,町域,R_町域,地名,R_地名) "
                        strSQL = strSQL & "VALUES('" & rs.Fields!郵便番号.Value & "','" & rs.Fields!都道府県.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_県.Value & "','" & rs.Fields!市区町村.Value & "',"
                        strSQL = strSQL & "'" & rs.Fields!R_市.Value & "','" & rs.Fields!町域.Value & "',"
                        If InStr(tch(0), "（第") > 0 And InStr(tch(1), "第") = 0 Then
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（第" & tch(ti) & "）','(ﾀﾞｲ" & R_tch(ri) & ")');"
                        Else
                            strSQL = strSQL & "'" & rs.Fields!R_町域.Value & "','（" & tch(ti) & "）','(" & R_tch(ri) & ")');"
                        End If
                    End If
                    db.Execute(strSQL)
                End If
            Next
            rs.MoveNext()
            'ProgressBar2の値を変更する
            r_c = r_c + 1
            ProgressBar2.Value = r_c

'Label1のテキストを変更する
            Label1.Text = "'、'で区切られた町域データの分離中です。" & r_c.ToString() & "/" & ProgressBar2.Maximum
            Application.DoEvents()

End While

rs.Close() : rs = Nothing

'カナテーブルの"及び"で区切られたデータの分離
        strSQL = "SELECT M_住所.* "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE (M_住所.地名) Like '*及び*' ;"
        rs = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

While rs.EOF = False
            '地名データの'及び'での分離。R_地名は'ｵﾖﾋ'
            Dim tch() As String = Split(rs.Fields!地名.Value, "及び")
            Dim R_tch() As String = Split(rs.Fields!R_地名.Value, "ｵﾖﾋﾞ")
            Dim t As Integer = tch.Length '地名の配列数
            Dim r As Integer = R_tch.Length  'R_地名の配列数
            Dim f As Integer = If(t > r, t, If(t = r, t, r))
            Dim i As Integer = 0
            Dim ri As Integer
            Dim ti As Integer

For i = 0 To f - 1
                ri = If(i > r - 1, r - 1, i)
                ti = If(i > t - 1, t - 1, i)

If r = 1 Then
                    If i = 0 Then '町域の分割更新
                        strSQL = "UPDATE M_住所 SET M_住所.地名 ='" & tch(ti) & "' "
                        strSQL = strSQL & "WHERE (((M_住所.ID)=" & rs.Fields!ID.Value & "));"
                    Else '町域の分割追加
                        strSQL = "INSERT INTO  M_住所 (郵便番号,都道府県,R_県,市区町村,R_市,町域,R_町域,地名) "
                        strSQL = strSQL & "VALUES('" & rs.Fields!郵便番号.Value & "','" & rs.Fields!都道府県.Value & "'"
                        strSQL = strSQL & ",'" & rs.Fields!R_県.Value & "','" & rs.Fields!市区町村.Value & "'"
                        strSQL = strSQL & ",'" & rs.Fields!R_市.Value & "','" & rs.Fields!町域.Value & "'"
                        strSQL = strSQL & ",'" & rs.Fields!R_町域.Value & "','" & tch(ti) & "');"
                    End If
                    db.Execute(strSQL)
                Else
                    If i = 0 Then '町域の分割更新
                        strSQL = "UPDATE M_住所 SET M_住所.地名 ='" & tch(ti) & "）', M_住所.R_地名 = '" & R_tch(ri) & ")' "
                        strSQL = strSQL & "WHERE (((M_住所.ID)=" & rs.Fields!ID.Value & "));"
                    Else '町域の分割追加
                        strSQL = "INSERT INTO  M_住所 (郵便番号,都道府県,R_県,市区町村,R_市,町域,R_町域,地名,R_地名) "
                        strSQL = strSQL & "VALUES('" & rs.Fields!郵便番号.Value & "','" & rs.Fields!都道府県.Value & "'"
                        strSQL = strSQL & ",'" & rs.Fields!R_県.Value & "','" & rs.Fields!市区町村.Value & "'"
                        strSQL = strSQL & ",'" & rs.Fields!R_市.Value & "','" & rs.Fields!町域.Value & "'"
                        strSQL = strSQL & ",'" & rs.Fields!R_町域.Value & "','（" & tch(ti) & "','(" & R_tch(ri) & "');"
                    End If
                    db.Execute(strSQL)
                End If
            Next
            rs.MoveNext()
        End While
        rs.Close() : rs = Nothing

'丁目、番地以外の文字列を含まない（）内のデータを註釈に移動(分離後の移動）
        '　移動対象のデータの抽出
        strSQL = "SELECT [地名], [R_地名], [註釈], [R_註釈] "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE [地名]<>'' And ([地名] Like '*丁目*)' Or [地名] Like '*番地)' Or [地名] Like '*以外)' "
        strSQL = strSQL & "Or [地名] Like '*以上)' Or [地名] Like '*以下)'  Or [地名] Like '*以降）' Or [地名] Like '*以内）'"
        strSQL = strSQL & "Or [地名] Like '*#）' Or [地名] Like '*～*）' Or [地名] Like '*－*）');"

Dim rs2 As DAO.Recordset = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

While rs2.EOF = False
            '数値化できるかチェック

Dim t_change As String = rs2.Fields!地名.Value

If Deci = True Then '数値化できたデータだけを移動
                rs2.Edit()
                rs2.Fields!R_註釈.Value = rs2.Fields!R_地名.Value
                rs2.Fields!R_地名.Value = ""
                rs2.Fields!註釈.Value = rs2.Fields!地名.Value
                rs2.Fields!地名.Value = ""
                rs2.Update()
            End If
            rs2.MoveNext()
        End While

rs2.Close() : rs2 = Nothing

strSQL = "ALTER TABLE M_住所 ALTER COLUMN R_町域 TEXT(255);"
        db.Execute(strSQL)

strSQL = "ALTER TABLE M_住所 ALTER COLUMN R_地名 TEXT(255);"
        db.Execute(strSQL)

Me.Label1.Text = "'、'で区切られた町域（地名）データの分離が終了しました。"
        Application.DoEvents()

db.Close() : db = Nothing

End Sub

読み仮名が記載されていない通名に読み仮名を追加

対象データ

Private Sub 通り名ブランク修正()
        Dim strSQL As String
        Dim strSQL2 As String

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

Label1.Text = "通名のブランクｶﾅデータの追加中です。"

'通名がブランクの作業用テーブル作成
        strSQL = "SELECT [市区町村], [地名], Mid([地名],2,Len([地名])-2) AS 置換確認, [R_地名] INTO 通名BL "
        strSQL = strSQL & "FROM M_住所 "
        strSQL = strSQL & "WHERE [市区町村] Like '京都市*' AND [地名]<>'' AND [R_地名]='';"

db.Execute(strSQL)

'作業テーブルの置換確認が""になるまで通名置換の名前と比較しカナデータの追加と置換確認の語彙消去を行う
        strSQL = "SELECT * "
        strSQL = strSQL & "FROM 通名置換 "
        strSQL = strSQL & "ORDER BY 通名置換.文字長 DESC;"
        Dim rs As DAO.Recordset = db.OpenRecordset(strSQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

Dim i As Integer

Do Until Dcount("置換確認", "通名BL", "置換確認<>''") = 0
            While rs.EOF = False
                If i < 8 Then
                    strSQL2 = "UPDATE 通名BL "
                    strSQL2 = strSQL2 & "SET [置換確認] = Mid([置換確認],Len('" & rs.Fields![名前].Value & "')+1)"
                    strSQL2 = strSQL2 & ", [R_地名] = [R_地名] & '" & rs.Fields![読み].Value & "' "
                    strSQL2 = strSQL2 & "WHERE (((通名BL.[置換確認]) Like '" & rs.Fields![名前].Value & "*'));"
                    db.Execute(strSQL2)
                Else
                    Label1.Text = "通名のｶﾅ追加に失敗しました。"
                    Stop
                End If
                rs.MoveNext()
            End While
            i = i + 1
            rs.MoveFirst()
        Loop

rs.Close() : rs = Nothing

'(、)追加
        strSQL = "UPDATE 通名BL SET 通名BL.R_地名 = '(' & [R_地名] & ')';"
        db.Execute(strSQL)

'住所テーブルにカナデータを反映
        strSQL = "UPDATE M_住所 RIGHT JOIN 通名BL ON M_住所.地名 = 通名BL.地名 SET M_住所.R_地名 = [通名BL]![R_地名];"
        db.Execute(strSQL)

'作業テーブルの削除
        strSQL = "DROP TABLE 通名BL ;"
        db.Execute(strSQL)

db.Close() : db = Nothing

End Sub

市と区を分離

対象データ

Private Sub 市区分離() '市区分離処理
        Dim strSQL As String
        Dim i As Integer

db = DbE.OpenDatabase(db_path() + "\anocora.mdb")

'スペースなしの市町村データを作成
        strSQL = "SELECT Left([市区町村],InStr([市区町村],'　')-1) & Mid([市区町村],InStr([市区町村],'　')+1) AS 市区町村置換"
        strSQL = strSQL & ", Left([市区町村],InStr([市区町村],'　')-1) AS 政令市, '' AS R_市"
        strSQL = strSQL & ", Mid([市区町村],InStr([市区町村],'　')+1) AS 区, '' AS R_区 INTO 市区分離変換 "
        strSQL = strSQL & "FROM R_住所 "
        strSQL = strSQL & "WHERE [市区町村] Like '*市*' And [市区町村] Like '*区*' "
        strSQL = strSQL & "GROUP BY R_住所.市区町村;"
        db.Execute(strSQL)
        Label1.Text = " R_住所とM_住所連結の為の市町村データを作成しました。"
        Application.DoEvents()

'市区分離変換テーブル作成
        'UPDATE 市区分離変換 RIGHT JOIN M_住所 ON 市区分離変換.市区町村置換 = M_住所.市区町村 SET 市区分離変換.[R_市] = [M_住所]![R_市];
        strSQL = "UPDATE M_住所 RIGHT JOIN 市区分離変換 ON M_住所.市区町村 = 市区分離変換.市区町村置換 "
        strSQL = strSQL & "SET [市区分離変換]![R_市] = [M_住所]![R_市];"
        db.Execute(strSQL)
        Label1.Text = "市区分離変換テーブル作成を作成しました。"
        Application.DoEvents()

'政令市のカナ表記抽出
        '   政令市抽出クエリ
        Dim 政令市SQL As String = "SELECT [政令市] FROM 市区分離変換 GROUP BY [政令市];"

Dim rs2 As DAO.Recordset = db.OpenRecordset(政令市SQL, DAO.RecordsetTypeEnum.dbOpenDynaset)

'   R_市の文字列から政令市の共通文字列を抽出
        While rs2.EOF = False

'政令市抽出クエリの政令市と同じデータを持つ、市区分離変換テーブルのレコードを抽出。
            Dim strSQL2 As String = "SELECT [政令市],[R_市] FROM 市区分離変換 "
            strSQL2 = strSQL2 & "WHERE [政令市]='" & rs2.Fields!政令市.Value & "';"
            Dim rs3 As DAO.Recordset = db.OpenRecordset(strSQL2, DAO.RecordsetTypeEnum.dbOpenDynaset)
            Dim kana_si As String = ""

i = 1
            Dim k As Integer = Len(rs3.Fields!R_市.Value)
            Dim srshi As String = rs3.Fields!R_市.Value
            Do Until i > k '先頭レコードと次のレコードのR_市のデータを先頭から1文字づつ比較。

kana_si = kana_si & srshi.Substring(i - 1, 1)

While rs3.EOF = False
                    If rs3.Fields!R_市.Value.Substring(0, i) <> kana_si Then '差異が発生したしたら、区の更新をしてループから出る。
                        kana_si = kana_si.Substring(0, i - 1)
                        Dim strSQL3 As String = "UPDATE 市区分離変換 "
                        strSQL3 = strSQL3 & "SET [R_区] = mid([R_市],len('" & kana_si & "')+1) "
                        strSQL3 = strSQL3 & "WHERE [政令市]='" & rs2.Fields!政令市.Value & "';"
                        db.Execute(strSQL3)

strSQL3 = "UPDATE 市区分離変換 "
                        strSQL3 = strSQL3 & "SET [R_市]='" & kana_si & "' "
                        strSQL3 = strSQL3 & "WHERE [政令市]='" & rs2.Fields!政令市.Value & "';"
                        db.Execute(strSQL3)
                        Exit Do
                    End If
                    rs3.MoveNext()
                End While
                rs3.MoveFirst()
                i = i + 1
            Loop

rs3.Close() : rs3 = Nothing

rs2.MoveNext()
        End While

rs2.Close() : rs2 = Nothing

Label1.Text = "市区分離変換テーブルに区のカナ表記を追加しました。"
        Application.DoEvents()

'分離処理
        'strSQL = "UPDATE M_住所 INNER JOIN 市区分離変換 ON M_住所.市区町村 = 市区分離変換.市区町村置換 SET M_住所.市区町村 = [市区分離変換]!政令市, M_住所.R_市 = [市区分離変換]!R_市, M_住所.区 = [市区分離変換]!区, M_住所.R_区 = [市区分離変換]!R_区;"
        strSQL = "UPDATE M_住所 INNER JOIN 市区分離変換 ON M_住所.市区町村 = 市区分離変換.市区町村置換 "
        strSQL = strSQL & "SET[M_住所]![市区町村] = [市区分離変換]![政令市], [M_住所]![R_市] = [市区分離変換]![R_市]"
        strSQL = strSQL & ", [M_住所]![区] = [市区分離変換]![区], M_住所.[R_区] = [市区分離変換]![R_区];"
        db.Execute(strSQL)
        Label1.Text = "市区分離処理を終了しました。。"
        Application.DoEvents()

strSQL = "DROP TABLE 市区分離変換;"
        db.Execute(strSQL)

db.Close() : db = Nothing

End Sub

郡を削除

対象データ

ここまでは、多少は汎用性があると思います。
ここから先は、業務システム用の専用処理です。

A’nocora 郵便番号データの住所入力データ化

処理の考え方

課題

Schema.ini

別モジュールでの設定

DAOの参照設定

ZIPの参照設定

ＰＵＢＬＩＣで宣言したDBE変数

db_path()

Dcount

DLookup

フォーム

変換テーブル

スクリプト

宣言

メインスクリプト

郵便番号データのダウンロードと解凍処理

対象データ

対象データ

対象データ

町域データをスペース位置で、町域と地名に分割します。 スペースが複数ある時は、更に地名と註釈に分割します。

読み仮名データ（カナ表記）を取得して、町域と地名に分割後、変換テーブルの内容をM_住所に反映します。 複数のスペースで地名と註釈に分離されたデータは、読み仮名の分離処理も行います。

対象データ

対象データ

対象データ

対象データ

郡を削除

対象データ

A’nocora　郵便番号データの住所入力データ化

町域データをスペース位置で、町域と地名に分割します。
スペースが複数ある時は、更に地名と註釈に分割します。

読み仮名データ（カナ表記）を取得して、町域と地名に分割後、変換テーブルの内容をM_住所に反映します。
複数のスペースで地名と註釈に分離されたデータは、読み仮名の分離処理も行います。