
A 回答 (10件)
- 最新から表示
- 回答順に表示
No.10
- 回答日時:
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
- 回答日時:
こんばんは。
私のほうは、正規表現でやってみたつもりが、全国レベルになるとうまくいかないものが出てきて、結局、個別処理なんていう方法を取らざるを得ませんでした。とても、褒められたコードではありませんが、せっかくエラーのでないレベルに達したもので、公開しておきます。一応、このコードの味噌は、最長マッチと最短マッチの妙ですね。
ただし、
東京都利島村利島村一円
等の島で、村が最初に来るもの対応していません。
'//
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
- 回答日時:
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
- 回答日時:
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
- 回答日時:

No.5
- 回答日時:
[No.1補足]へのコメント、
》 その場合は、空白にする事はできますでしょうか?
そのこと自体は簡単だけど、下記のような実在する住所の場合にも対応させなきゃならんとすると、私にはお手上げです。
北海道河東郡音更町柳町南区
北海道河西郡更別村旭区
福井県坂井市春江町為国中区
兵庫県多可町中区
岡山県岡山市南区北七区
No.4
- 回答日時:
ネット上にはこんなものがあります
全国の市町村コード一覧
http://citycode.fmd4.com/home
こういった物をうまく使うとやりやすいでしょう
例えば"市"だけで探そうとすると千葉県市原市とか市川市とかは変なところで区切られてしまう
一覧表を作ってVLOOKUP関数で拾い出すとか
何かしらの規則性を見つけ出すとか
東京都の場合であれば6文字目まで取れば区別は付きそうですね
直接の回答にはなっていません、あしからず
No.2
- 回答日時:
Q、「区」を抽出する関数?
A、ほとんど不可能。
一度、そういう関数の作成に挑戦したことがあります。
Step1、全国の地名を郵便番号一覧で調査・分析。
まず、ここで・・・。
都郡市山市
などの例外的サンプルを抽出することから。結果、相当に、この類の地名・住所が存在することが判明。
【結果】郵便番号簿解析ツールを利用するのが一番確実。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで、Scroll Lockと同じ...
-
表計算ソフトでの様式の呼称
-
エクセルでフィルターした値を...
-
【画像あり】【関数】指定した...
-
エクセルシートの見出しの文字...
-
【マクロ】【画像あり】4つの...
-
【関数】3つのセルの中で最新...
-
【マクロ】excelファイルを開く...
-
【マクロ】【画像あり】❶ブック...
-
【マクロ】【画像あり】ファイ...
-
エクセルに写真が貼れない(フ...
-
【関数】=EXACT(a1,b1) a1とb1...
-
Excelに貼ったXのURLのリンク...
-
【マクロ】既存ファイルの名前...
-
LibreOffice Clalc(またはエク...
-
Dir関数のDo Whileステートメン...
-
空白のはずがSUBTOTAL関数でカ...
-
【マクロ】【画像あり】4つの...
-
セルにぴったし写真を挿入
-
EXCELのVBAで複数のシートを追...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【マクロ】実行時エラー '424':...
-
エクセルのVBAで集計をしたい
-
Office2021のエクセルで米国株...
-
【画像あり】オートフィルター...
-
vba テキストボックスとリフト...
-
他のシートの検索
-
【マクロ】【相談】Excelブック...
-
【マクロ】【配列】3つのシー...
-
【マクロ】元データと同じお客...
-
【マクロ】数式を入力したい。...
-
【マクロ】左のブックと右のブ...
-
エクセルの関数について
-
エクセルのリストについて
-
【マクロ】変数に入れるコード...
-
エクセルシートの見出しの文字...
-
【マクロ】excelファイルを開く...
-
【関数】3つのセルの中で最新...
-
エクセルの複雑なシフト表から...
-
【マクロ】【画像あり】❶ブック...
-
LibreOffice Clalc(またはエク...
おすすめ情報