住所から「区」を抜き出すには

質問

いつもお世話になっています。

Excelで「区」を抽出する関数を教えていただけませんでしょうか。
幾つか調べましたが、参考にしながらも上手く作る事ができませんでした。

神奈川県川崎市幸区●●●●●123456　⇒　幸区
東京都港区●●●●●●123456　⇒　港区

そして、市があって区が無い場合は「市」を抽出したいです。
神奈川県大和市●●●●●●123456　⇒　大和市

よろしくおねがいいたします。

回答No.10

hallo-2007

No4の方の
全国の市町村コード一覧
http://citycode.fmd4.com/home
を利用してみました。
Sheet2に上記サイトのデータを貼り付け
市町村名にある空白を置き換えの機能で削除
画像にあるようなデータにします。

A列に住所があるとして
B列に　県名を表示する式
=IF(MID(A2,4,1)="県",LEFT(A2,4),LEFT(A2,3))
県名を表示させるのは簡単です。
C列に市町村名を表示させるにはSheet2の市町村名のデータを利用して
=MID(A2,LEN(B2)+1,MAX(IF(COUNTIF(Sheet2!D:D,LEFT(REPLACE(A2,1,LEN(B2),""),COLUMN(A1:H1)))>0,COLUMN(A1:H1),0)))
と入れて　Ctrl＋Shift+Enter　で決定させて
B、C列を下までコピーします。

回答No.9

WindFaller

こんばんは。

私のほうは、正規表現でやってみたつもりが、全国レベルになるとうまくいかないものが出てきて、結局、個別処理なんていう方法を取らざるを得ませんでした。とても、褒められたコードではありませんが、せっかくエラーのでないレベルに達したもので、公開しておきます。一応、このコードの味噌は、最長マッチと最短マッチの妙ですね。

ただし、
　東京都利島村利島村一円
等の島で、村が最初に来るもの対応していません。

'//
Sub Test1()
　Dim s As Long, k As Long, g As Long, kn As Long, s2 As Long, d As Long, m as Long, t as Long
　Dim c As Range
　Dim buf As String
　Application.ScreenUpdating = False
　With CreateObject("VBScript.RegExp")
　　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　buf = c.Value
　　　buf = SpecialArrange(buf, c)
　　　g = InStr(buf, "郡"): s = InStr(buf, "市")
　　　k = InStr(buf, "区"): kn = InStr(buf, "県")
　　　d = InStr(buf, "北海道"): s2 = InStr(s + 1, buf, "市")
　　　m = InStr(buf, "町"): t = InStr(buf, "都")

　　　If (k > 0 Or t > 0) And s2 = 0 And m = 0 And s = 0 And (s - k = 1 Or g - k = 1 Or s - k > 1) Then
　　　　.Pattern = "[都道府県](.*[区市])"
　　　ElseIf g > 0 And g - kn > 1 And g - d > 1 And g - s > 1 And s2 = 0 And s * g <> 0 And s < g Then
　　　　.Pattern = "[都道府県]([^市]*[市])"
　　　ElseIf g > 0 And g - kn > 1 And g - d > 1 And (s = 0 Or g - s > 1) Then
　　　　.Pattern = "[都道府県]([^郡]*[郡])"
　　　ElseIf g > 0 And s > 0 And s - g = 1 Then
　　　　.Pattern = "[都道府県](.+市)" '蒲郡市
　　　ElseIf g > 0 And s > 0 And g - kn > 1 And (g > d) And (g < s Or g < s2) Then
　　　　.Pattern = "[都道府県]([^郡].*郡)"
　　　ElseIf g > 0 And k = 0 And s - kn = 1 Then
　　　　.Pattern = "[都道府県](.*市)" '市原市
　　　ElseIf s2 > 0 And k = 0 And s - kn = 1 Then
　　　　.Pattern = "[都道府県](市[^市]*市)" '市原市
　　　ElseIf g > 0 And k = 0 And g - kn > 1 And s < g Then
　　　　.Pattern = "[都道府県]([^市].*市)"
　　　ElseIf g > 0 And k = 0 And g - kn > 1 Then
　　　　.Pattern = "[都道府県]([^郡市町].*[郡市町])"
　　　ElseIf g > 0 And g - kn = 1 Then '郡山仕様
　　　　.Pattern = "[都道府県]([^市町]*[市町])"
　　　ElseIf (d > 0 Or k > 0) And s > 0 And s2 = 0 And g = 0 Then
　　　　.Pattern = "[都道府県](.*市)"
　　　ElseIf s2 - s = 1 Then
　　　　.Pattern = "[都道府県]([^市]+市市)" '野々市
　　　ElseIf s2 - s = 1 Then
　　　　.Pattern = "[都道府県]([^市].*市)"
　　　ElseIf s > 0 And s2 > 1 And m = 0 And s2 - s > 1 And s - kn > 1 Then
　　　　.Pattern = "[都道府県]([^市]*市)"
　　　ElseIf s > 0 And m = 0 And (s2 - s > 1 Or s2 = 0) And s - kn > 1 Then
　　　　.Pattern = "[都道府県]([^市].*市)"
　　　ElseIf s > 0 And m > 0 And s - kn > 1 Then
　　　　.Pattern = "[都道府県]([^市]*市)"
　　　ElseIf s2 > 0 Then
　　　　.Pattern = "[都道府県](.*市)"
　　　ElseIf g = 0 And k > 0 Then
　　　　.Pattern = "[都道府県]([^区].*区)"
　　　ElseIf g > s Then
　　　　.Pattern = "[都道府県]([^郡].*郡)" '余市郡
　　　ElseIf InStr(c.Value, "利島村") = 0 Then
　　　　.Pattern = "[都道府県]([^郡市町区].*[郡市町区])"
　　　Else
　　　'unfixed
　　　End If
　　　.Global = True
　　　On Error Resume Next
　　　If .Test(buf) Then
　　　　With .Execute(buf)(0)
　　　　　buf = .SubMatches(0)
　　　　　c.Offset(, 1).Value = buf
　　　　End With
　　　End If
　　　If Err.Number > 0 Then c.Offset(, 1).Value = ""
　　　On Error GoTo 0
　　Next c
　　Application.ScreenUpdating = True
　End With
End Sub
Function SpecialArrange(buf As Variant, rng As Range)
　　'個別対応
　　 If InStr(buf, "市市場") > 0 Then
　　　　buf = Replace(buf, "市市場", "市")
　　　ElseIf InStr(buf, "今市市") > 0 Then
　　　　rng.Offset(, 1).Value = "今市市"
　　　　buf = ""
　　　ElseIf InStr(buf, "余市町") > 0 And InStr(buf, "郡") = 0 Then
　　　　rng.Offset(, 1).Value = "余市町"
　　　　buf = ""
　　　ElseIf InStr(buf, "郡市") > 0 Then '栃木県芳賀郡市貝帳
　　　　buf = Mid(buf, 1, InStr(buf, "郡市"))
　　　ElseIf InStr(buf, "四日市市") > 0 Then　'奈良県大和郡
　　　　 rng.Offset(, 1).Value = "四日市市"
　　　　 buf = ""
　　　ElseIf InStr(buf, "市市野") > 0 Then '佐渡市市野沢
　　　　buf = Mid(buf, 1, InStr(buf, "市市"))
　　　ElseIf InStr(buf, "市市") > 0 Then '佐渡市市野沢
　　　　buf = Mid(buf, 1, InStr(buf, "市"))
　　　ElseIf InStr(buf, "市郡中") > 0 Then　'郡中新田
　　　　buf = Replace(buf, "市郡中", "市")
　　　ElseIf InStr(buf, "臼杵市市浜") > 0 Then　'臼杵市
　　　　buf = Replace(buf, "臼杵市市浜", "臼杵市")
　　　ElseIf InStr(buf, "大和郡") > 0 Then　'奈良県大和郡
　　　　　buf = Mid(buf, 1, InStr(buf, "大和郡") + 2)
　　　ElseIf InStr(buf, "四日市市市場") > 0 Then　'奈良県大和郡
　　　　　buf = Replace(buf, "四日市市市場", "四日市市")
　　　End If
　 SpecialArrange = buf
End Function

回答No.8

weboner

VLOOKUPで拾える一覧表作ってみました

No4で提示した市町村コード表をコピーして
http://citycode.fmd4.com/home

新規ブックsheet1のA1セルに貼り付けた後に下記マクロを実施してください

Sub sample()

Sheets("Sheet1").Range("A1").Select
Rows("1:4").Select
Selection.Delete Shift:=xlUp
Columns("A:C").Select
Range("C1").Activate
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("D1").Select
ActiveCell.FormulaR1C1 = "=RC[-3]&RC[-2]&RC[-1]"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D1935")
Range("D1:D1935").Select
Range("E1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],5)"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-2],8)"
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(FIND(""区"",RC[-4])),RC[-5],RC[-4])"
Range("E1:G1").Select
Selection.AutoFill Destination:=Range("E1:G1935")
Range("E1:G1935").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT((RC[-7]&RC[-1]=R1C1:RC[-7]&R1C7:RC[-1])*1)"
Selection.AutoFill Destination:=Range("H1:H1935")
Range("H1:H1935").Select
ActiveWindow.SmallScroll Down:=-12
Range("H1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$H$1935").AutoFilter Field:=8, Criteria1:="1"
Range(Selection, Selection.End(xlDown)).Select
Range("E1:H1934").Select
Range("H1").Activate
ActiveWindow.SmallScroll Down:=-177
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("D:D").Delete Shift:=xlToLeft

End Sub

sheet2に一覧表ができますので
セル範囲 A1:C1358 に表5
セル範囲 B1:C1358 に表8
と名前を定義してください

=IFERROR(VLOOKUP(LEFT(住所,8),表8,2,0),VLOOKUP(LEFT(住所,5),表5,3,0))

これで抽出可能になるはずです

今後市町村合併等があっても最新の市町村コード表から対応表を作り直せば、対応可能かと思われます

回答No.7

weboner

No4です、ちょいと補足

全国的に見ると

北海道余市町
山形県東村山郡
山形県西村山郡
山形県北村山郡
千葉県市原市
千葉県市川市
東京都町田市
東京都東村山市
東京都武蔵村山市
新潟県十日町市
福島県郡山市
群馬県北群馬郡
長野県大町市
広島県廿日市市
愛知県四日市市
↑
思いつくところをざっと上げてみた

まだあるかもしれないけど
この辺りの市町村郡の文字が含まれている市町村群の扱いをどう処理するか

市と区のみの抽出まで進んだところで、止まってしまった
=IFERROR(MID(E5,MAX(4,IFERROR(FIND("市",E5),0)+1),FIND("区",E5)),MID(E5,(MID(E5,4,1)="県")+4,FIND("市",E5,5)-(MID(E5,4,1)="県")-3))

回答No.6

NotFound404

若干の手直しが必要かもしれませんけど、こちらで試してみたら？

住所を分割する
http://menushowdelay.blog.fc2.com/?no=525

回答No.5

noname#204879

[No.1補足]へのコメント、
》 その場合は、空白にする事はできますでしょうか？
そのこと自体は簡単だけど、下記のような実在する住所の場合にも対応させなきゃならんとすると、私にはお手上げです。
北海道河東郡音更町柳町南区
北海道河西郡更別村旭区
福井県坂井市春江町為国中区
兵庫県多可町中区
岡山県岡山市南区北七区

回答No.4

weboner

ネット上にはこんなものがあります

全国の市町村コード一覧
http://citycode.fmd4.com/home

こういった物をうまく使うとやりやすいでしょう

例えば"市"だけで探そうとすると千葉県市原市とか市川市とかは変なところで区切られてしまう

一覧表を作ってVLOOKUP関数で拾い出すとか
何かしらの規則性を見つけ出すとか

東京都の場合であれば6文字目まで取れば区別は付きそうですね

直接の回答にはなっていません、あしからず

回答No.3

yomyom01

・四日市市の場合最初の”市”で四日市と判定するので無理

回答No.2

山田 太郎（@f_a_007）

Q、「区」を抽出する関数？
A、ほとんど不可能。

一度、そういう関数の作成に挑戦したことがあります。

Step１、全国の地名を郵便番号一覧で調査・分析。

まず、ここで・・・。

都郡市山市

などの例外的サンプルを抽出することから。結果、相当に、この類の地名・住所が存在することが判明。

【結果】郵便番号簿解析ツールを利用するのが一番確実。

回答No.1

noname#204879

》 市があって区が無い場合は「市」を抽出したい
市も区もない場合は、どうするどうする？

補足

mike_gさん
ありがとうございます。市も区もない場合があるのですね。身近になかったので想定すらしていませんでした...。

その場合は、空白にする事はできますでしょうか？よろしくお願いいたします。