[[20050121161337]] 『住所を離す方法』(5963) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『住所を離す方法』(5963)

いつもお世話になっております。
人の作った住所録の修正をしています。
『東京都』『世田谷区』『自由が丘1丁目』とあったら、「&」でくっつけて
『東京都世田谷区自由が丘1丁目』とするのと逆に

         A                  B          C         D    

1  『東京都世田谷区自由が丘1丁目』  『東京都』  『世田谷区』  『自由が丘1丁目』
  

  
とA列をB列、C列、D列にわけるのにはどうしたらいいのでしょうか?
よろしくお願いします。(5963)


LEFT関数、MID関数、RIGHT関数を使ってそれぞれ文字をピックアップして、
上からコピーの「値貼付」をすればいいのでは?
(*各関数についてはEXCELのヘルプを見てください)
(困った子)

ヘルプを見ました。
文字数が同じでないと例題のようにわけることはできないのでしょうか?

        A                  B          C         D    

1  『東京都世田谷区自由が丘1丁目』  『東京都』  『世田谷区』  『自由が丘1丁目』
  

2   『神奈川県横浜市青葉区』     『神奈川県』  『横浜市』   『青葉区』

と200件ほど続きます。理解力に乏しくてすいません。教えてください。(5963)


 入力されている住所次第ですが、↓が参考になりませんか?  (Hatch)
[[20041008223005]]『郵便番号から、住所を複数セルへ振り分ける方法』(コミキ)

ありがとうございます、拝見させていただきましたが、
初心者の私には、ちょっと難しいのかなー・・・(>_<)
もうすこし、簡単に出来るのかななんて思っていました。
でも、大変勉強になりました。ありがとうございました。(5963)


文字をどこで分けるかは人の判断になるので,機械に自動で分けることは不可でしょう。

  区,県,市などを区切り末尾と決めておけば,マクロコードで作れないことは
 ないと思いますが。  そこまでの元気は今ないですね。
(なお)


 住所の内容にもよりますが・・・
 私が良く使う手としましては、まず例の内容で行くと

   A                 B    C    D    E
 1 東京都世田谷区自由が丘1丁目
 2 神奈川県横浜市青葉区    

 住所のA欄を変換で、「都」は「都 」(都の後ろはスペース)に、「県」は「県 」に、
 「区」は「区 」に、「市」は「市 」にそれぞれ一括で変換をかけてしまいます。

   A                  B    C    D    E
 1 東京都 世田谷区 自由が丘1丁目
 2 神奈川県 横浜市 青葉区     

 それにそぐわないものだけを手作業で編集しておいて、
 後はデータ→区切り位置で、スペースをキーに区切ってしまえば、
 (ウイザードの2ページ目のスペースにチェック)

   A        B        C        D    E
 1 東京都     世田谷区    自由が丘1丁目
 2 神奈川県    横浜市     青葉区     

 このようになりますが、どうでしょうか?
 (OP)


 「都道府県」「市区町村」「その下の分類」の3つのブロックに分ける、
という条件なら OPさんの方法がベストでしょう。ただし、○○市○○区と
ある場合は、ブロックがもう一つ増えてしまいます。また、市区町村名その
ものに「市」とか「町」とかある市川市や町田市などもあって、そういう
ところは手作業、ということでしょうね。
(とんとん)

 こういうばやいはなんたってスペシャル関数でっせ。
 完成品やおまへんけど、住所を分割するにはもってこいの関数ですワ、えぇ。
 まあ、いっぺん試してみておくんなはれ。

 愛知県郡上市馬宿町3番地15
 千葉県今市市町谷3番町
 栃木県八日市市新居浜市5条
 北海道余市郡余市町3番地
 太宰府市西町5丁目
 東京都町田市区役所前(ほんなとこは無いで)

 とか、その他いろいろ従来の関数では補えない分割(エラーとか割り間違い)を
 大部分カバーでけると思いまんねんけど、まぁ、それもこの頭やと限界があります
 もんでな、そこんとこは手入力でカバーしておくんなはれ。

 まあ、なにはともあれ試してみる価値は充分おまっせぇ。
 上手い事いったら・・・それはあんさん運がええっちゅう事ですワ。

 先ず最初に下のコードを標準モジュールにコピペしておくんなはれ
 コピーのやりかたはお分かりでっしゃろ?

 '-------------------------------
 Public end_adrs As Long
 Public flag As Boolean
 Public adrs3, adrs1
 Public sp_data
 Public tbl As Range
 Public adrs As String
 Option Base 1
 '--------------------------------
 Function yata(data)
    Dim get_sty()
    Dim n As Integer, i As Integer, mid_cnt As Integer
    Dim get_data As String
    Dim city As Integer, gun As Integer

    Application.EnableEvents = True
    adrs3 = ActiveCell.Column
    Set tbl = Range(data.Address(0, 0))
    If data.Address Like "*:*" Then
        adrs = data.Address(0, 0)
        adrs_data = Split(data.Address(0, 0), ":")
        adrs1 = adrs_data(0)
        adrs2 = Range(adrs_data(1)).Rows
        st_adrs = tbl.Cells(1, 1).Row
        end_adrs = tbl.Rows.Count
        data = Range(adrs1)

        flag = True

    ActiveCell(-1).Formula = "=yata (" & adrs1 & ")"
    End If
    sp_data = ""
    If data = "" Then yata = "": Exit Function

    Select Case Left(data, 3)
        Case "大阪府", "京都府", "東京都", "北海道"
            sp_data = Left(data, 3) & ","
            mid_cnt = 3
        Case Else
            For i = 3 To 4
                If Mid(data, i, 1) = "県" Then
                    sp_data = Left(data, i) & ","
                    mid_cnt = i
                    Exit For
                End If
            Next i
    End Select

    get_data = Mid(data, mid_cnt + 1, 77)
    n = InStr(get_data, "市")
    city = InStr(n + 1, get_data, "市")
    gun = InStr(get_data, "郡")
    If n <> 0 Then
        If city <> 0 And city < 6 Then
            Select Case Left(get_data, city)
                Case "八日市場市", "市川市", "市原市", "今市市", "四日市市", _
                            "八日市市", "廿日市市"
                    sp_data = sp_data & Left(get_data, city) & ","
                    mid_cnt = mid_cnt + city
                Case Else
                    If Left(get_data, 3) <> "余市郡" Then
                        sp_data = sp_data & Mid(get_data, 1, n) & ","
                        mid_cnt = mid_cnt + n
                    End If
            End Select
        ElseIf gun <> 0 And n > gun Then
            If get_data Like "郡上市*" Or get_data Like "小郡市*" Or get_data Like _
                    "郡山市*" Or get_data Like "蒲郡市*" Or get_data Like "大和郡山市*" Then
                sp_data = sp_data & Mid(get_data, 1, n) & ","
                mid_cnt = mid_cnt + n
            End If
        ElseIf gun <> 0 And n < gun Then
            If Mid(get_data, 1, gun) <> "高市郡" Then
                sp_data = sp_data & Mid(get_data, 1, n) & ","
                mid_cnt = mid_cnt + n
            End If
        Else
            If n <> 1 Then
                sp_data = sp_data & Mid(get_data, 1, n) & ","
                mid_cnt = mid_cnt + n
            End If

        End If
    End If

    get_data = Mid(data, mid_cnt + 1, 77)
    n = InStr(get_data, "区")
    If n > 1 And n < 5 Then
        sp_data = sp_data & Mid(get_data, 1, n) & ","
        mid_cnt = mid_cnt + n
    End If

    get_data = Mid(data, mid_cnt + 1, 69)
    If Not sp_data Like "*市*" And Not sp_data Like "*区*" Then
        n = InStr(get_data, "郡")
        If n > 1 Then
            sp_data = sp_data & Mid(get_data, 1, n) & ","
            mid_cnt = mid_cnt + n
        End If
    End If
    get_data = Mid(data, mid_cnt + 1, 77)
    n = InStr(get_data, "町")
    If n > 1 Then
        sp_data = sp_data & Mid(get_data, 1, n) & ","
        mid_cnt = mid_cnt + n
    ElseIf InStrRev(get_data, "町") > n Then
        sp_data = sp_data & Mid(get_data, 1, InStrRev(get_data, "町")) & ","
        mid_cnt = mid_cnt + InStrRev(get_data, "町")

    End If
    get_data = Mid(data, mid_cnt + 1, 77)
    sp_data = sp_data & Mid(get_data, 1, 77) & ","
    yata = Split(sp_data, ",")(0)
    sp_data = Right(sp_data, Len(sp_data) - Len(yata) - 1)

 End Function

 '次はシート1に下のコードをコピペしておくんなはれ
 '-------------------------------
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim msg As Range
    Dim i As Integer, t As Integer, m As Integer, f As Integer, n As Integer
    Dim rng As String, trgt_data As String
    Dim data_a
    Static j As Integer

    If Target.Count > 1 Then Exit Sub
    On Error GoTo trbl
    data_a = Target.Formula
    If data_a Like "*:*" Then
        j = 0
        Range(Target.Address(0, 0)).Formula = "=yata(" & adrs1 & ")"
        Exit Sub
    End If
    Set msg = Intersect(Target, tbl)
    If msg Is Nothing And Left(data_a, 6) <> "=yata(" Then Exit Sub
    trgt_data = sp_data
    If Not msg Is Nothing Then
        Do
            i = i + 1
            If Left(Cells(Target.Row, i).Formula, 6) = "=yata(" Then
                Cells(Target.Row, i).Select
                Cells(Target.Row, i).Formula = Cells(Target.Row, i).Formula
                If Target = "" Then Cells(Target.Row, i + 1).Resize(, 7).ClearContents
                Exit Sub
            End If
        Loop While i < 255
    End If

    If Left(data_a, 6) = "=yata(" Then
        Application.EnableEvents = False
        Target.Offset(, 1).Resize(, 7).ClearContents
        t = InStr(data_a, "(")
        m = InStr(data_a, ")")
        rng = Mid(data_a, t + 1, m - t - 1)
        msoft = Split(trgt_data, ",", -1)
        For i = 0 To UBound(msoft)
            f = Application.WorksheetFunction.Find(msoft(i), Range(rng), 1)
            n = Len(msoft(i))
            If msoft(i) <> "" Then
                Target.Offset(, i + 1).Formula = "=mid(" & rng & "," & f & "," & n & ")"
            End If
        Next i
    End If
    If flag Then
        Application.EnableEvents = True
        For j = j + 1 To end_adrs
            Range(adrs).Cells(j + 1, adrs3).Formula = "=yata(" & Range(adrs).Cells(1, 1).Offset(j).Address(0, 0) & ")"
        Next j

    End If
    flag = False
 trbl:
    Application.EnableEvents = True

 End Sub

 '------------------------------------------
 使用方法は
 単独なら、例えばA1のデータを分割したいなら データを抽出したいセルに
 =yata(a1)と叩いてくらはい。
 またまとまったデータがあるばやいは=yata(a1:a500)
 といった塩梅に入力したらあんさんの希望するデータがズラーッと並びますワ。

 ただこれ、未完成品ですので平行行でのみ有効です。(元データがA1からやとC1とか
 D1とかに=yata( )に入力しておくんなはれ)
 行がずれても言う事は聞きますけど、データを変更した時に得たい結果に?マーク
 がつきますから、それは悪しからず。(笑

 ほな・・・(弥太郎)

 師匠!!お久しぶりです。
よぉ!日本一!!!!!
(SoulMan) 


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.