東京都利島村のQ&A

  • 締切済

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

    • 2015/1/11
    • lanlanlan1122

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

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

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

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

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

    続きを読む

  • 回答

    • 2015/1/14
    • 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

    続きを読む