[VBA]日本の都道府県名、地方公共団体名を抜き出す

Step 0 注意と構成

注意

これはあくまでも個人で作成したもので誤りなく動くかは保証できません。
また郵便番号マスターは12万行を超えるため、解析は古いバージョンのエクセルでは無理です
また行政の区分を表す文字が漢字で書かれていないと対応しません。

##記事の構成
基本的な手順
データの入手
分析のための整理方法
現在の完成例

Step1 基本的な手順

##抜き出す順番
住所データから市区町村郡名を取り出す方法 AllAbout
ただし2008年のため2ページ目の鹿町町は現在は存在していない
ここでは「区→町→市→村」
の順に抜き出すとしているが、これは郡がない。
しかし現在のところ
区があるところは郡がない
という法則があるので
「都道府県名→区→郡→あいまい→村→町→市→」
の順に抜き出し、これをパブリック変数に代入して分解する。

##あいまい
あいまいとは六ヶ所村のようなケとヶが両方使われるようなところ。また日の出町のような日之出、日ノ出など複数の表記が可能なものをいう。
##抜き出すときの問題
抜き出すときはExcelのWorkSheetFunction.Findを使っている。
ここで問題になるのは自治体の区分を示す文字（国県都都市など）を含む名称である。
そのため「解析」をおこなって、こうした自治体がどれくらいあるのか確認する。
一応最後の完成版はそれを行って作ったが、ミスがあるかもしれない。利用は自己責任でお願いしたい。
###2018/1/10更新
　地方自治体の詳細な住所に自治体の区分を表す文字がある場合、処理がうまくいかない場合があることが判明。
　特に市の場合、次に郡がくるとうまく処理できないので、fnCitiesは市と郡を比較して字数が少ない方を採用し、市の場合はパブリック変数をクリアするようにした。そのたでもいくつか変更した。
　最後の完成版についてはworksheetfunction.Findを InStrに変えてExcel Access 共用化できた。

2018/10/07

都道府県名でいったん初期化

Step2 データの入手

住所の郵便番号（ローマ字）（CSV形式）
これがないと何郡かがわからない
全国地方公共団体コード(総務省)
PDFとexcelがあるがExcelをダウンロードする。このコードをAccessではキーとして使用するため重要である。

英語の表記方法 PDF
都道府県 Prefecture
郡 country
市 city ※東京都23区はcity
区 ward
町 Town
村 Village
東京都はTokyo Metropolis
北海道 Hokkaido Prefecture
後は府県をとってPrefectureに変える

直接データとして使わないが、変数の命名で参考になる。
ここで重要なのは東京都の23区は他の区と違い市と同等であるということである。
つまり東京都23区に限っては分解したときに区の変数pubWardと市の変数pubCityの両方に代入する

#Step 3 分析のための整理方法
総務省のデータは郡と結びついていないため、これを郵便番号コードから抜き出さなければならない。しかしこのデータはかなり重複している。
また１セルに ◎◎郡全角スペース〇〇町
のようになっており、分割しなければならない。

総務省のデータへの式の入力

=LEFT(C3,LEN(C3)-1)
H28.10.10政令指定都市のD列に解析に必要な関数をいれる
=MID(B2,FIND("市",B2,1)+1,LEN(B2))

##郵便番号マスターの郡 区の分割
郵便番号のマスターをダウンロードし、エクセルで開く
まずKEN_ALL_ROMEシート
都道府県名 市区町村名　だけ残して削除する
##項目名
都道府県名 市区町村名 郡市名 区町村名
といれるこのとき2行目は
北海道 札幌市 空白　空白となる
次にこれをフィルターにかけて詳細設定でユニークな値(重複しない値)にする
$A$1:$B$124118
これを別のシートにコピーする

新しいシートで
D2とE2に次の関数をいれる
=MID(B2,1,FIND("　",B2,1)-1)
=MID(B2,FIND("　",B2,1)+1,LEN(B2))

これをVBAであらわすと次のようになる

Sub WardCountryList()
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:H").Select
Selection.Delete Shift:=xlToLeft
Range("A1") = "都道府県名"
Range("B1").Value = "市区町村名"
Range("C1") = "郡市名"
Range("D1") = "区町村名"
Columns("B:B").EntireColumn.AutoFit
Rows("1:1").Select
Selection.AutoFilter
Range("A1:B124118").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Columns("A:D").Select
Range("D1").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Columns("A:D").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$1897").AutoFilter Field:=2, Criteria1:="<>*市", _
Operator:=xlAnd
Columns("A:D").Select
Range("D1").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Columns("A:D").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Range("E5").Select
Columns("B:B").EntireColumn.AutoFit
Range("C2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=MID(RC[-1],1,FIND(""　"",RC[-1],1)-1)"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-2],FIND(""　"",RC[-2],1)+1,LEN(RC[-2]))"
Range("C2:D2").Select
Selection.Copy
Range("B2").Select
Selection.End(xlDown).Select
Range("C1126:D1126").Select
Range(Selection, Selection.End(xlUp)).Select
Range("C3:D1126").Select
Range("C1126").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
End Sub

これで抜き出した市町村からさらに末尾の1字を抜く。
抜いたもので国都道府県市町村ヶケの乃之が含まれるものを確認する

現在の例

2018/10/7更新

addresspart

Public ipubPref As Long '都道府県の番号1-47が入る
Public pubPrefectrure As String '都道府県名
Public pubWard As String
Public pubCity As String
Public pubTown As String
Public pubVillage As String
Public pubGunName As String

Function fnPrefecture(straddress As String) As String
' 都道府県名を抜き出す関数
' Public 変数に代入する
Dim i As Long
Dim arPref
' Public 変数初期化(変更点)
pubPrefectrure = ""
pubWard = ""
pubCity = ""
pubGunName = ""
pubTown = ""
pubVillage = ""
' 終了:Public 変数初期化
ipubPref = 0
arPref = Split("北海道,青森県,岩手県,宮城県,秋田県,山形県,福島県,茨城県,栃木県,群馬県,埼玉県,千葉県,東京都,神奈川県,新潟県,富山県,石川県,福井県,山梨県,長野県,岐阜県,静岡県,愛知県,三重県,滋賀県,京都府,大阪府,兵庫県,奈良県,和歌山県,鳥取県,島根県,岡山県,広島県,山口県,徳島県,香川県,愛媛県,高知県,福岡県,佐賀県,長崎県,熊本県,大分県,宮崎県,鹿児島県,沖縄県", ",")
For i = LBound(arPref) To UBound(arPref)
If straddress Like arPref(i) & "*" Then ipubPref = i + 1: pubPrefectrure = arPref(i): fnPrefecture = arPref(i): Exit Function
Next i
pubPrefectrure = ""
ipubPref = 0
fnPrefecture = ""
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''' 区名を抜き出す '''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function fnWard(straddress As String) As String
Dim i As Long
Dim arSapporoWard: arSapporoWard = Split("中央区,北区,東区,白石区,豊平区,南区,西区,厚別区,手稲区,清田区", ",")
Dim arSendaiward: arSendaiward = Split("青葉区,宮城野区,若林区,太白区,泉区", ",")
Dim arSaitamaWard: arSaitamaWard = Split("西区,北区,大宮区,見沼区,中央区,桜区,浦和区,南区,緑区,岩槻区", ",")
Dim arTokyoWard: arTokyoWard = Split("千代田区,中央区,港区,新宿区,文京区,台東区,墨田区,江東区,品川区,目黒区,大田区,世田谷区,渋谷区,中野区,杉並区,豊島区,北区,荒川区,板橋区,練馬区,足立区,葛飾区,江戸川区", ",")
Dim arChibaWard: arChibaWard = Split("中央区,花見川区,稲毛区,若葉区,緑区,美浜区", ",")
Dim arYokohamaWard: arYokohamaWard = Split("鶴見区,神奈川区,西区,中区,南区,保土ケ谷区,磯子区,金沢区,港北区,戸塚区,港南区,旭区,緑区,瀬谷区,栄区,泉区,青葉区,都筑区", ",")
Dim arKawasakiWard: arKawasakiWard = Split("川崎区,幸区,中原区,高津区,多摩区,宮前区,麻生区", ",")
Dim arSagamiharaWard: arSagamiharaWard = Split("緑区,中央区,南区", ",")
Dim arNiigataWard: arNiigataWard = Split("北区,東区,中央区,江南区,秋葉区,南区,西区,西蒲区", ",")
Dim arShizuokaWard: arShizuokaWard = Split("葵区,駿河区,清水区", ",")
Dim arHamamatsuWard: arHamamatsuWard = Split("中区,東区,西区,南区,北区,浜北区,天竜区", ",")
Dim arNagoyaWard: arNagoyaWard = Split("千種区,東区,北区,西区,中村区,中区,昭和区,瑞穂区,熱田区,中川区,港区,南区,守山区,緑区,名東区,天白区", ",")
Dim arKyotoWard: arKyotoWard = Split("北区,上京区,左京区,中京区,東山区,下京区,南区,右京区,伏見区,山科区,西京区", ",")
Dim arOsakaWard: arOsakaWard = Split("都島区,福島区,此花区,西区,港区,大正区,天王寺区,浪速区,西淀川区,東淀川区,東成区,生野区,旭区,城東区,阿倍野区,住吉区,東住吉区,西成区,淀川区,鶴見区,住之江区,平野区,北区,中央区", ",")
Dim arSakaiWard: arSakaiWard = Split("堺区,中区,東区,西区,南区,北区,美原区", ",")
Dim arKobeWard: arKobeWard = Split("東灘区,灘区,兵庫区,長田区,須磨区,垂水区,北区,中央区,西区", ",")
Dim arHiroshimaWard: arHiroshimaWard = Split("中区,東区,南区,西区,安佐南区,安佐北区,安芸区,佐伯区", ",")
Dim arOkayamaWard: arOkayamaWard = Split("北区,中区,東区,南区", ",")
Dim arKitakyusyuWard: arKitakyusyuWard = Split("門司区,若松区,戸畑区,小倉北区,小倉南区,八幡東区,八幡西区", ",")
Dim arFukuokaWard: arFukuokaWard = Split("東区,博多区,中央区,南区,西区,城南区,早良区", ",")
Dim arKumamotoWard: arKumamotoWard = Split("中央区,東区,西区,南区,北区", ",")
Select Case ipubPref
Case Is = 1
For i = LBound(arSapporoWard) To UBound(arSapporoWard)
If straddress Like "*" & arSapporoWard(i) & "*" Then fnWard = arSapporoWard(i): pubWard = arSapporoWard(i): pubPrefectrure = "北海道": pubCity = "札幌市": Exit Function
Next i
Case Is = 4
For i = LBound(arSendaiward) To UBound(arSendaiward)
If straddress Like "*" & arSendaiward(i) & "*" Then fnWard = arSendaiward(i): pubWard = arSendaiward(i): pubPrefectrure = "宮城県": pubCity = "仙台市": Exit Function
Next i
Case Is = 11
For i = LBound(arSaitamaWard) To UBound(arSaitamaWard)
If straddress Like "*" & arSaitamaWard(i) & "*" Then fnWard = arSaitamaWard(i): pubWard = arSaitamaWard(i): pubPrefectrure = "埼玉県": pubCity = "埼玉市": Exit Function
Next i
Case Is = 12
For i = LBound(arChibaWard) To UBound(arChibaWard)
If straddress Like "*" & arChibaWard(i) & "*" Then fnWard = arChibaWard(i): pubWard = arChibaWard(i): pubPrefectrure = "千葉県": pubCity = "千葉市": Exit Function
Next i
Case Is = 13
For i = LBound(arTokyoWard) To UBound(arTokyoWard)
If straddress Like "*" & arTokyoWard(i) & "*" Then fnWard = arTokyoWard(i): pubWard = arTokyoWard(i): pubPrefectrure = "東京都": pubCity = arTokyoWard(i): Exit Function
Next i
Case Is = 14
For i = LBound(arYokohamaWard) To UBound(arYokohamaWard)
If straddress Like "*" & arYokohamaWard(i) & "*" Then fnWard = arYokohamaWard(i): pubPrefectrure = "神奈川県": pubCity = "横浜市": Exit Function
Next i
For i = LBound(arKawasakiWard) To UBound(arKawasakiWard)
If straddress Like "*" & arKawasakiWard(i) & "*" Then fnWard = arKawasakiWard(i): pubPrefectrure = "神奈川県": pubCity = "川崎市": Exit Function
Next i
For i = LBound(arSagamiharaWard) To UBound(arSagamiharaWard)
If straddress Like "*" & arSagamiharaWard(i) & "*" Then fnWard = arSagamiharaWard(i): pubPrefectrure = "神奈川県": pubCity = "相模原市": Exit Function
Next i
Case Is = 15
For i = LBound(arNiigataWard) To UBound(arNiigataWard)
If straddress Like "*" & arNiigataWard(i) & "*" Then fnWard = arNiigataWard(i): pubPrefectrure = "新潟県": pubCity = "新潟市": Exit Function
Next i
Case Is = 22
For i = LBound(arShizuokaWard) To UBound(arShizuokaWard)
If straddress Like "*" & arShizuokaWard(i) & "*" Then fnWard = arShizuokaWard(i): pubPrefectrure = "静岡県": pubCity = "静岡市": Exit Function
Next i
For i = LBound(arHamamatsuWard) To UBound(arHamamatsuWard)
If straddress Like "*" & arHamamatsuWard(i) & "*" Then fnWard = arHamamatsuWard(i): pubPrefectrure = "静岡県": pubCity = "浜松市": Exit Function
Next i
Case Is = 23
For i = LBound(arNagoyaWard) To UBound(arNagoyaWard)
If straddress Like "*" & arNagoyaWard(i) & "*" Then fnWard = arNagoyaWard(i): pubWard = arNagoyaWard(i): pubPrefectrure = "愛知県": pubCity = "名古屋市": Exit Function
Next i
Case Is = 26
For i = LBound(arKyotoWard) To UBound(arKyotoWard)
If straddress Like "*" & arKyotoWard(i) & "*" Then fnWard = arKyotoWard(i): pubWard = arKyotoWard(i): pubPrefectrure = "京都府": pubCity = "京都市": Exit Function
Next i
Case Is = 27
For i = LBound(arOsakaWard) To UBound(arOsakaWard)
If straddress Like "*" & arOsakaWard(i) & "*" Then fnWard = arOsakaWard(i): pubWard = arOsakaWard(i): pubPrefectrure = "大阪府": pubCity = "大阪市": Exit Function
Next i
For i = LBound(arSakaiWard) To UBound(arSakaiWard)
If straddress Like "*" & arSakaiWard(i) & "*" Then fnWard = arSakaiWard(i): pubWard = arSakaiWard(i): pubPrefectrure = "大阪府": pubCity = "堺市": Exit Function
Next i
Case Is = 28
For i = LBound(arKobeWard) To UBound(arKobeWard)
If straddress Like "*" & arKobeWard(i) & "*" Then fnWard = arKobeWard(i): pubWard = arKobeWard(i): pubPrefectrure = "兵庫県": pubCity = "神戸市": Exit Function
Next i
Case Is = 33
For i = LBound(arOkayamaWard) To UBound(arOkayamaWard)
If straddress Like "*" & arOkayamaWard(i) & "*" Then fnWard = arOkayamaWard(i): pubWard = arOkayamaWard(i): pubPrefectrure = "岡山県": pubCity = "岡山市": Exit Function
Next i
Case Is = 34
For i = LBound(arHiroshimaWard) To UBound(arHiroshimaWard)
If straddress Like "*" & arHiroshimaWard(i) & "*" Then fnWard = arHiroshimaWard(i): pubPrefectrure = "広島県": pubCity = "広島市": Exit Function
Next i
Case Is = 40
For i = LBound(arFukuokaWard) To UBound(arFukuokaWard)
If straddress Like "*" & arFukuokaWard(i) & "*" Then fnWard = arFukuokaWard(i): pubPrefectrure = "福岡県": pubCity = "福岡市": Exit Function
Next i
For i = LBound(arKitakyusyuWard) To UBound(arKitakyusyuWard)
If straddress Like "*" & arKitakyusyuWard(i) & "*" Then fnWard = arKitakyusyuWard(i): pubWard = arKitakyusyuWard(i): pubPrefectrure = "福岡県": pubCity = "福岡市": Exit Function
Next i
Case Is = 43
For i = LBound(arKumamotoWard) To UBound(arKumamotoWard)
If straddress Like "*" & arKumamotoWard(i) & "*" Then fnWard = arKumamotoWard(i): pubWard = arKumamotoWard(i): pubPrefectrure = "熊本県": pubCity = "熊本市": Exit Function
Next i
Case Else
pubWard = ""
fnWard = ""
End Select
End Function
Function fnCountry(straddress As String) As String
Dim i As Long
Dim buf As String
Dim tmp As String, iCnt As Long
Dim arExGunName: arExGunName = Split("東村山郡,西村山郡,北村山郡,田村郡,余市郡,高市郡,小県郡,山県郡,北諸県郡,西諸県郡,東諸県郡,東国東郡,国東郡", ",")
Dim arExCityName: arExCityName = Split("市川市,市原市,野々市市,四日市市,廿日市市,村山市,田村市,町田市,東村山市,武蔵村山市,羽村市,十日町市,村上市,大町市,大村市,山県市,伊豆の国市,南国市,郡山市,郡上市,蒲郡市,上郡町,大和郡山市,宇都宮市,小郡市,都留市,京都市,都城市,西都市,府中市,甲府市,大府市,江府町,府中市,府中町,防府市,太宰府市,別府市,四街道市,道志村,尾道市", ",")
fnPrefecture (straddress)
If pubWard <> "" Then fnCountry = "": Exit Function
pubGunName = ""
buf = Replace(straddress, pubPrefectrure, "", 1, 1, vbTextCompare)
'他の行政区画を表す漢字が含まれる郡名を先に抜き出す
For i = LBound(arExGunName) To UBound(arExGunName)
If buf Like "*" & arExGunName(i) & "*" Then pubGunName = arExGunName(i): fnCountry = arExGunName(i): Exit Function
Next i
'郡が含まれる市だったら
For i = LBound(arExCityName) To UBound(arExCityName)
If buf Like "*" & arExCityName(i) & "*" Then pubCity = arExCityName(i): fnCountry = "": pubGunName = "": Exit Function
Next i
On Error Resume Next
'郡名を抜き出す
'iCnt = WorksheetFunction.Find("郡", buf, 1)
iCnt = InStr(1, buf, "郡", vbTextCompare)

If Err.Number = 0 Then
pubGunName = Mid(buf, 1, iCnt)
fnCountry = Mid(buf, 1, iCnt)
Exit Function
End If
On Error GoTo 0
pubGunName = ""
fnCountry = ""
End Function
Public Function FazzyName(straddress As String) As String
If pubWard <> "" Then Exit Function
Dim buf As String
Dim i As Long
buf = Replace(Replace(straddress, pubPrefectrure, "", 1, 1, vbTextCompare), pubGunName, "", 1, 1, vbTextCompare)
Dim str As String
Dim strLocal As String
'表記が揺れる村ケヶ
Dim arGaKeNameVillages: arGaKeNameVillages = Split("青ヶ島村,六ヶ所村", ",")
For i = LBound(arGaKeNameVillages) To UBound(arGaKeNameVillages)
strLocal = arGaKeNameVillages(i)
If buf Like "*" & strLocal & "*" Then pubVillage = arGaKeNameVillages(i): Exit Function
strLocal = Replace(strLocal, "ヶ", "ケ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubVillage = arGaKeNameVillages(i): Exit Function
strLocal = Replace(strLocal, "ケ", "ヶ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubVillage = arGaKeNameVillages(i): Exit Function
Next i

'表記が揺れる町ケヶ
Dim arGaKeNameTowns: arGaKeNameTowns = Split("外ヶ浜町,鰺ヶ沢町,七ヶ宿町,七ヶ浜町,,吉野ヶ里町,五ヶ瀬町,金ケ崎町,関ケ原町", ",")
For i = LBound(arGaKeNameTowns) To UBound(arGaKeNameTowns)
strLocal = arGaKeNameTowns(i)
If buf Like "*" & strLocal & "*" Then pubTown = arGaKeNameTowns(i): Exit Function
strLocal = Replace(strLocal, "ヶ", "ケ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arGaKeNameTowns(i): Exit Function
strLocal = Replace(strLocal, "ケ", "ヶ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arGaKeNameTowns(i): Exit Function
Next i
'表記が揺れる市ケヶ
Dim arGaKeNameCities: arGaKeNameCities = Split("鶴ヶ島市,茅ヶ崎市,駒ヶ根市,龍ケ崎市,鎌ケ谷市,袖ケ浦市,四日市市", ",")
For i = LBound(arGaKeNameCities) To UBound(arGaKeNameCities)
strLocal = arGaKeNameCities(i)
If buf Like "*" & strLocal & "*" Then pubCity = arGaKeNameCities(i): Exit Function
strLocal = Replace(strLocal, "ヶ", "ケ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arGaKeNameCities(i): Exit Function
strLocal = Replace(strLocal, "ケ", "ヶ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arGaKeNameCities(i): Exit Function
'日をカヵヶ(2018/1/10追加)
strLocal = Replace(strLocal, "日", "カ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arGaKeNameCities(i): Exit Function
strLocal = Replace(strLocal, "日", "ヵ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arGaKeNameCities(i): Exit Function
strLocal = Replace(strLocal, "日", "ヶ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arGaKeNameCities(i): Exit Function
Next i
'表記が揺れる町ノ
Dim arInNoNameTowns: arInNoNameTowns = Split("日の出町,隠岐の島町,いの町,中之条町,輪之内町,日之影町,徳之島町,上ノ国町,山ノ内町,西ノ島町", ",")
For i = LBound(arInNoNameTowns) To UBound(arInNoNameTowns)
strLocal = arGaKeNameTowns(i)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "の", "ノ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "の", "之", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "の", "乃", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "ノ", "の", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "ノ", "之", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "ノ", "乃", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "之", "の", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "之", "乃", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
strLocal = Replace(strLocal, "之", "ノ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubTown = arInNoNameTowns(i): Exit Function
Next i
'表記が揺れる市ノ
Dim arInNoNameCities: arInNoNameCities = Split("伊豆の国市,たつの市,紀の川市,えびの市,牧之原市,西之表市", ",")
For i = LBound(arInNoNameCities) To UBound(arInNoNameCities)
strLocal = arInNoNameCities(i)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "の", "ノ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "の", "之", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "の", "乃", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "ノ", "の", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "ノ", "之", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "ノ", "乃", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "之", "の", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "之", "乃", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
strLocal = Replace(strLocal, "之", "ノ", 1, 1, vbTextCompare)
If buf Like "*" & strLocal & "*" Then pubCity = arInNoNameCities(i): Exit Function
Next i
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''' 町名を抜き出す '''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fnTowns(straddress As String) As String
' 地方自治体としての町名を抜き出す関数
' 合わせてパブリック変数に代入する
'区が入っていれば違うので終了する
If pubWard <> "" Then pubTown = "": fnTowns = "": Exit Function
'市が入っていれば違うので終了する。ただしいちき串木野市より長い字数は偽と判定する。(変更点)
If pubCity <> "" Or ((fnCities(straddress) <> "") And (Len(fnCities(straddress)) < 8)) Then pubTown = "": fnTowns = "": Exit Function
'村が入っていれば違うので終了する
'If pubVillage <> "" Then pubTown = "": fnTowns = "": Exit Function '無効化
'町が入っていれば終了する
'If pubTown <> "" Then fnTowns = pubTown: Exit Function
Dim i As Long
Dim buf As String
Dim tmp As String, iCnt As Long
Dim arExGunName: arExGunName = Split("東村山郡,西村山郡,北村山郡,田村郡,余市郡,高市郡,小県郡,山県郡,北諸県郡,西諸県郡,東諸県郡,東国東郡,国東郡", ",")
Dim arExCityName: arExCityName = Split("市川市,市原市,野々市市,四日市市,廿日市市,村山市,田村市,町田市,東村山市,武蔵村山市,羽村市,十日町市,村上市,大町市,大村市,山県市,伊豆の国市,南国市,郡山市,郡上市,蒲郡市,上郡町,大和郡山市,宇都宮市,小郡市,都留市,京都市,都城市,西都市,府中市,甲府市,大府市,江府町,府中市,府中町,防府市,太宰府市,別府市,四街道市,道志村,尾道市", ",")
'町の中に他の行政区分をあらわす文字があるもの
Dim arExTownName As Variant: arExTownName = Split("余市町,市貝町,上市町,市川三郷町,市川町,上郡町,下市町,村田町,玉村町,大町町,寿都町,山都町,都農町,訓子府町,利府町,江府町,小国町,南小国町,四日市町", ",") '四日市町は現在は存在しないが処理の必要がありそうなので追加。
'村の中に他の行政区分をあらわす文字があるもの
Dim arExVillageName: arExVillageName = Split("留寿都村,音威子府村", ",")
'他の行政区分を表す漢字が入ってくるものを処理
For i = LBound(arExCityName) To UBound(arExCityName)
If straddress Like "*" & arExCityName(i) & "*" Then pubCity = arExCityName(i): fnTowns = "": Exit Function
Next
'郡名の取得
If pubGunName = "" Then
For i = LBound(arExGunName) To UBound(arExGunName)
If straddress Like "*" & arExGunName(i) & "*" Then pubGunName = arExGunName(i): Exit For
Next
End If
'If pubGunName = "" Then pubGunName = Mid(Replace(strAddress, pubPrefectrure, "", 1, -1, vbTextCompare), 1, WorksheetFunction.Find("郡", Replace(strAddress, pubPrefectrure, "", 1, -1, vbTextCompare), 1))
On Error Resume Next
buf = Replace(Replace(straddress, pubPrefectrure, "", 1, 1, vbTextCompare), pubGunName, "", 1, 1, vbTextCompare)
For i = LBound(arExTownName) To UBound(arExTownName)
If buf Like "*" & arExTownName(i) & "*" Then fnTowns = arExTownName(i): Exit Function
Next
'iCnt = WorksheetFunction.Find("町", buf, 1)
iCnt = InStr(1, buf, "町", vbTextCompare)
If ERR.Number = 0 Then
pubTown = Mid(buf, 1, iCnt)
If pubVillage Like "*" & pubTown & "*" Then pubVillage = Replace(pubVillage, pubTown, "", 1, 1, vbTextCompare)
fnTowns = pubTown
Exit Function
End If
On Error GoTo 0
pubTown = ""
fnTowns = ""
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''' 村名を抜き出す '''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function fnVillage(straddress As String) As String
' 地方自治体としての村名を抜き出す関数
' 合わせてパブリック変数に代入する
' 区が入っていれば違うので終了する
If pubWard <> "" Then pubVillage = "": fnVillage = "": Exit Function
'市が入っていれば違うので終了する。ただしいちき串木野市より長い字数は偽と判定する。(変更点)
If pubCity <> "" Or ((fnCities(straddress) <> "") And (Len(fnCities(straddress)) < 8)) Then pubTown = "": fnTowns = "": Exit Function
'町が入っていれば違うので終了する
If pubWard <> "" Or pubCity <> "" Or pubTown <> "" Then pubVillage = "": fnVillage = "": Exit Function
'村が入っていれば終了する
If pubVillage <> "" Then fnVillage = pubVillage: Exit Function
Dim i As Long
Dim buf As String
Dim tmp As String, iCnt As Long
Dim arExGunName: arExGunName = Split("東村山郡,西村山郡,北村山郡,田村郡,余市郡,高市郡,小県郡,山県郡,北諸県郡,西諸県郡,東諸県郡,東国東郡,国東郡", ",")
Dim arExCityName: arExCityName = Split("市川市,市原市,野々市市,四日市市,廿日市市,村山市,田村市,町田市,東村山市,武蔵村山市,羽村市,十日町市,村上市,大町市,大村市,山県市,伊豆の国市,南国市,郡山市,郡上市,蒲郡市,上郡町,大和郡山市,宇都宮市,小郡市,都留市,京都市,都城市,西都市,府中市,甲府市,大府市,江府町,府中市,府中町,防府市,太宰府市,別府市,四街道市,道志村,尾道市", ",")
'町の中に他の行政区分をあらわす文字があるもの
Dim arExTownName As Variant: arExTownName = Split("余市町,市貝町,上市町,市川三郷町,市川町,上郡町,下市町,村田町,玉村町,大町町,寿都町,山都町,都農町,訓子府町,利府町,江府町,小国町,南小国町", ",")
'村の中に他の行政区分をあらわす文字があるもの
Dim arExVillageName: arExVillageName = Split("留寿都村,音威子府村", ",")
'他の行政区分を表す漢字が入ってくるものを処理
For i = LBound(arExVillageName) To UBound(arExVillageName)
If straddress Like "*" & arExVillageName(i) & "*" Then pubVillage = arExVillageName(i): fnVillage = arExVillageName(i): Exit Function
Next
For i = LBound(arExTownName) To UBound(arExTownName)
If straddress Like "*" & arExTownName(i) & "*" Then pubTown = arExTownName(i): fnVillage = "": Exit Function
Next
For i = LBound(arExCityName) To UBound(arExCityName)
If straddress Like "*" & arExCityName(i) & "*" Then pubCity = arExCityName(i): fnVillage = "": Exit Function
Next
If pubGunName = "" Then
For i = LBound(arExGunName) To UBound(arExGunName)
If straddress Like "*" & arExGunName(i) & "*" Then pubGunName = arExGunName(i):
Next
End If
On Error Resume Next
buf = Replace(Replace(straddress, pubPrefectrure, "", 1, 1, vbTextCompare), pubGunName, "", 1, 1, vbTextCompare)
'iCnt = WorksheetFunction.Find("村", buf, 1)
iCnt = InStr(1, buf, "村", vbTextCompare)
If ERR.Number = 0 Then
pubVillage = Mid(buf, 1, iCnt)
fnVillage = pubVillage
Exit Function
End If
On Error GoTo 0
pubVillage = ""
fnVillage = ""
End Function

''''''''''''''''''Test Code '''''''''''''''''''''''''''
Sub AddressPart()
Dim straddress As String
Dim buf As String
ipubPref = 0
pubPrefectrure = ""
pubWard = ""
pubCity = ""
pubTown = ""
pubVillage = ""
pubGunName = ""
straddress = "東京都新宿区市ヶ谷本村町"
'テスト用文字列(実在はしないがこれらの文字列でエラーが分かったため更新した)
'straddress = "熊本県上益城郡益城町常名上村都町町"
'straddress = "熊本県上益城郡益城町二重市市常名上村都町町"
'straddress = "熊本県八代市郡代町新都"

fnPrefecture (straddress)
fnWard (straddress)
fnCountry (straddress)
fnVillage (straddress)
fnTowns (straddress)
fnCities (straddress)
If pubPrefectrure <> "" Then buf = pubPrefectrure
If pubWard <> "" And ipubPref <> 13 Then buf = buf & pubCity & pubWard: Debug.Print buf: Exit Sub
If pubWard <> "" And ipubPref = 13 Then buf = buf & pubWard: Debug.Print buf: Exit Sub '東京だけは区でよいため
If pubWard = "" Then
If pubCity <> "" And Len(pubCity) <= 7 Then '市名は最大7文字
buf = buf & pubCity
Debug.Print buf: Exit Sub
End If
If pubGunName <> "" Then
buf = buf & pubGunName
End If
If pubVillage <> "" And Len(pubVillage) <= 5 Then '村名は最大5文字
buf = buf & pubVillage
Debug.Print buf: Exit Sub
End If
If pubTown <> "" And Len(pubTown) <= 6 Then '町名は最大6文字。ただしひらがなまでいれるとも
buf = buf & pubTown
Debug.Print buf: Exit Sub
End If
End If
End Sub