[[20100531222255]]　『マクロについて』（ヤイリ）　ページの最後に飛ぶ

『マクロについて』（ヤイリ）

 （とおりすがりん）さんに1000000	三重県四日市市河原田町0000を
 1000000 0000に絞り込むマクロは教えていただいたのですが下記のように

 1000000	三重県四日市市河原田町0000マンション101と２項目あって

 1000000	0000マンション101まで絞り込むにはなにか良い案ありますでしょうか？

[[20100531142456]]　『マクロで自動判別して対応するか住所項目を分けた』（ヤイリ）

 郵便番号1000000	三重県四日市市河原田町１丁目２番地３というパターンもあるので
 三重県四日市市河原田町と１丁目２番地３で分けるやり方や
 郵便番号1000000	１丁目２番地３ってのを絞ったりとかどちらか出来ると助かります。（ヤイリ）

 三重県四日市市　河原田町１丁目２番地３

 ちなみに上記のように区、市、町、村の４種類から区切って分けられる方法はありますでしょか？
 （ヤイリ）

 今日はほとんどとおりすがれないので、
 下記スレッドから関連を辿ってみてください。
[[20040625022224]]　『住所分割方法について』（キヨ）

 また、サイトの「全文検索」で「住所　分割」などで
 検索すると、過去の偉大な遺産が発掘できるかもです。
 （とおりすがりん）

 なんとなく、マクロで出来ると聞いたからマクロで、と言っているように感じるので
 数式＆手作業で行う方法を載せておきます。

 ・対象のcsvをエクセルで開く
 ・A列に郵便番号、B列に住所があるとして
 　　C列とD列全体を選択して右クリック→挿入
 ・C1のセルに「=text(A1,"0000000")」と記述
 ・D1のセルに「=RIGHT(A1,LEN(A1)-MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(A1)&1234567890))+1)」と記述
 ・C1を選択、shiftキーを押しながらD1も選択
 ・選択したセルを囲んでいる四角の右下にある小さい■をWクリック
 ・新規作成で新しいBOOKを作る
 ・住所のBOOKに戻り、C:D列全体を選択、コピー
 ・新規作成したBOOKのA１の上で右クリックし、「形式を選択して貼り付け」
 　→「値」にチェックをしてOK
 出来たものをcsv保存、でいかがでしょう？
 どうしてもマクロで！って場合は、回答者の出現を待ってみて下さい～

 式は前回リンク先のMaronさんのをちょっといじったものです
 （とおりすがりん）

 わざわざ丁寧にありがとうございます。結構こってますね。やってみます。
 ちなみにＡ１郵便番号1000000	Ｂ１三重県四日市市河原田町1-1-1というデータで
 3000件ほどこの前 （とおりすがりん）に作成していただいたマクロで郵便番号と住所の番号のみ抽出しようと思ったら
 100件ほどしか抽出されなかったのは何が原因と考えられるでしょうか？
 因みに３０００件ぐらいの住所をざっくりみても、半分以上はＯＯ県ＯＯ市ＯＯ町０－０－０－１０１のような形式なんです。
 （ヤイリ）

 >100件ほどしか抽出されなかったのは何が原因と考えられるでしょうか？
 とおりすがりんさんのコードを確認しました。
　
 下記で、A列の最終行を取得して、そこまでの回数をしています。
 >RowEnd = Range("A1").End(xlDown).Row
 A列には、データが全て入力されていますでしょうか？
 空欄等がある場合には、そこまでしか処理されないと思います。
　
 （キリキ）（〃⌒o⌒)b

 コメントありがとうございます。
 ハイフンがあるのは言い忘れてましたＡ列の郵便番号は000-0000がほとんどで
 未記入や0000とかも少しある感じでしたが、ザックリ見ても3000件のうち半分以上は
 郵便番号も住所も000-0000　ＯＯ県ＯＯ市ＯＯ町０－０－０－１０１
 こんな感じだったんですよね！
 私の見落としている部分がおそらくあるのでしょう。（ヤイリ）

 郵便番号項目の空白をすべてうめたら、すべて抽出出来ました。
 どうもありがとうございました。(ヤイリ
 )

 マクロでトライしてみました。。
 解決したようですが、一応張り付けときます。。
 手持ちの60,000件の住所データで試しましたが、わたしのPCで処理にかかる時間は、それぞれ30秒ぐらいかなぁ。
 過去ログを検索すると、もっと処理の早いステキなマクロがあるのでしょうが・・・^^

 >郵便番号1000000	１丁目２番地３ってのを絞ったりとかどちらか出来ると助かります。
 ※丁目および地番のないデータは、空白となります。

  Sub 郵便番号と番地等抽出()
    Dim i As Long
    Dim c As Byte

    Application.ScreenUpdating = False
    Sheets.Add                                 '新規にシートを作成する。
    ActiveSheet.Name = "郵便番号と番地等"      '新規シートに「郵便番号と番地等」と名前を付ける。
    Range("A1").Value = "郵便番号"             '表題に「郵便番号」を設定する。
    Range("B1").Value = "番地等"               '同様に「番地等」を設定する。
    Range("A:B").NumberFormatLocal = "@"       'A:B列を文字列にする。
    Sheets("Sheet1").Activate                  'データの入っている「Sheet1」をアクティブにする。
    With Sheets("郵便番号と番地等")                             'シート「郵便番号と番地等」をまとめて記述。
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row      'A列にデータが連続していると想定して、その件数だけ繰り返し処理を行なう。
            For c = 6 To Len(Cells(i, 2))                       '該当セルの、文字列の先頭6文字から最終文字までを繰り返す。
                If Mid(Cells(i, 1), 4, 1) <> "-" Then           '郵便番号に"-"が無いときは
                    .Cells(i + 1, 1).Value = Left(Cells(i, 1), 3) & "-" & Right(Cells(i, 1), 4)  '先頭から4番目に"-"を挿入して転記する。
                Else
                    .Cells(i + 1, 1).Value = Cells(i, 1)        'それ以外は、データの郵便番号を単純に転記する。
                End If
                If (Asc(Mid(Cells(i, 2), c, 1)) > 47 And Asc(Mid(Cells(i, 2), c, 1)) < 58) _
                    Or (Asc(Mid(Cells(i, 2), c, 1)) >= -32177 And Asc(Mid(Cells(i, 2), c, 1)) <= -32168) Then '半角と全角の0～9を検査。
                    .Cells(i + 1, 2).Value = _
                               WorksheetFunction.Substitute(Cells(i, 2), Left(Cells(i, 2), c - 1), "")        '町名部分を空白に置換して転記する。
                    Exit For     '繰り返し処理を抜ける。
                End If
            Next c               'c=c+1として繰り返す。
        Next i                   'i=i+1として繰り返す。
    End With
    Application.ScreenUpdating = True
  End Sub

 >三重県四日市市河原田町と１丁目２番地３で分けるやり方や
 ※丁目および地番のないデータは、空白となります。

  Sub 町名と番地等抽出()
    Dim i As Long
    Dim c As Byte

    Application.ScreenUpdating = False
    Sheets.Add
    ActiveSheet.Name = "町名と番地等"
    Range("A1").Value = "町名"
    Range("B1").Value = "番地等"
    Range("A:B").NumberFormatLocal = "@"
    Sheets("Sheet1").Activate
    With Sheets("町名と番地等")
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
            For c = 6 To Len(Cells(i, 2))
                If (Asc(Mid(Cells(i, 2), c, 1)) > 47 And Asc(Mid(Cells(i, 2), c, 1)) < 58) _
                    Or (Asc(Mid(Cells(i, 2), c, 1)) >= -32177 And Asc(Mid(Cells(i, 2), c, 1)) <= -32168) Then
                    .Cells(i + 1, 1).Value = Left(Cells(i, 2), c - 1)       '町名部分を転記する。
                    .Cells(i + 1, 2).Value = WorksheetFunction.Substitute(Cells(i, 2), Left(Cells(i, 2), c - 1), "")
                    Exit For
                Else
                    .Cells(i + 1, 1).Value = Cells(i, 2)
                End If
            Next c
        Next i
    End With
    Application.ScreenUpdating = True
 End Sub
 (kei)

 ありがとうございます。
 でもマクロをただ貼り付けるだけじゃないので内容が濃すぎて把握しきれてません。
 使えればかなり助かるのですが。
 解決したというよりは、ほんとは作成していただいたように分けれるのが理想なのですが
 出来そうもなかったので、以前作成していただいたマクロで対応してマンション名以降の
 号室などの取り込みはあきらめる か、住所データをすべて抽出してから
 住所の数字を含む文字をはじければ良いかなと思った感じだったのです。
 一応トライしてみますが把握出来てないし出来るかわかりませんがありがとうございます。
 （ヤイリ）

 こんばんわ。。
 町名までと、番地からマンション名最後の号室まで取り出せます。
 郵便番号と、番地からマンション名最後の号室まで取り出せます。
 上記の両方ともできます。。
 (kei)

 私がやらなければいけないことは、作成していただいたマクロの横の解説の部分でしょうか？
 データの入っている「Sheet1」をアクティブにする。
 シート「郵便番号と番地等」をまとめて記述。
 ほかにも色々よく分かりません。すいませんです。（ヤイリ）

 おはよーございます。。

 右のマクロの横の解説の部分は、単なるメモです。何も関係ありません。
 再度コードを書きますので、 
 ここから
 ↓
  Sub 郵便番号と番地等抽出()
    Dim i As Long
    Dim c As Byte

    Application.ScreenUpdating = False
    Sheets.Add                                 '新規にシートを作成する。
    ActiveSheet.Name = "郵便番号と番地等"      '新規シートに「郵便番号と番地等」と名前を付ける。
    Range("A1").Value = "郵便番号"             '表題に「郵便番号」を設定する。
    Range("B1").Value = "番地等"               '同様に「番地等」を設定する。
    Range("A:B").NumberFormatLocal = "@"       'A:B列を文字列にする。
    Sheets("Sheet1").Activate                  'データの入っている「Sheet1」をアクティブにする。
    With Sheets("郵便番号と番地等")                             'シート「郵便番号と番地等」をまとめて記述。
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row      'A列にデータが連続していると想定して、その件数だけ繰り返し処理を行なう。
            For c = 6 To Len(Cells(i, 2))                       '該当セルの、文字列の先頭6文字から最終文字までを繰り返す。
                If Mid(Cells(i, 1), 4, 1) <> "-" Then           '郵便番号に"-"が無いときは
                    .Cells(i + 1, 1).Value = Left(Cells(i, 1), 3) & "-" & Right(Cells(i, 1), 4)  '先頭から4番目に"-"を挿入して転記する。
                Else
                    .Cells(i + 1, 1).Value = Cells(i, 1)        'それ以外は、データの郵便番号を単純に転記する。
                End If
                If (Asc(Mid(Cells(i, 2), c, 1)) > 47 And Asc(Mid(Cells(i, 2), c, 1)) < 58) _
                    Or (Asc(Mid(Cells(i, 2), c, 1)) >= -32177 And Asc(Mid(Cells(i, 2), c, 1)) <= -32168) Then '半角と全角の0～9を検査。
                    .Cells(i + 1, 2).Value = _
                               WorksheetFunction.Substitute(Cells(i, 2), Left(Cells(i, 2), c - 1), "")        '町名部分を空白に置換して転記する。
                    Exit For     '繰り返し処理を抜ける。
                End If
            Next c               'c=c+1として繰り返す。
        Next i                   'i=i+1として繰り返す。
    End With
    Application.ScreenUpdating = True
  End Sub
  Sub 町名と番地等抽出()
    Dim i As Long
    Dim c As Byte

    Application.ScreenUpdating = False
    Sheets.Add
    ActiveSheet.Name = "町名と番地等"
    Range("A1").Value = "町名"
    Range("B1").Value = "番地等"
    Range("A:B").NumberFormatLocal = "@"
    Sheets("Sheet1").Activate
    With Sheets("町名と番地等")
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
            For c = 6 To Len(Cells(i, 2))
                If (Asc(Mid(Cells(i, 2), c, 1)) > 47 And Asc(Mid(Cells(i, 2), c, 1)) < 58) _
                    Or (Asc(Mid(Cells(i, 2), c, 1)) >= -32177 And Asc(Mid(Cells(i, 2), c, 1)) <= -32168) Then
                    .Cells(i + 1, 1).Value = Left(Cells(i, 2), c - 1)       '町名部分を転記する。
                    .Cells(i + 1, 2).Value = WorksheetFunction.Substitute(Cells(i, 2), Left(Cells(i, 2), c - 1), "")
                    Exit For
                Else
                    .Cells(i + 1, 1).Value = Cells(i, 2)
                End If
            Next c
        Next i
    End With
    Application.ScreenUpdating = True
 End Sub
 ↑
 ここまでをコピーして、標準モジュールに貼り付けて、、
 Sheet1のA列が郵便番号・・B列が住所であること。
 それぞれのマクロを実行してください。
 (kei)

ご丁寧にありがとうございます。必要な時に使用させていただきます。（ヤイリ）

コメント返信：

[ 一覧(最新更新順) ]

[[20100531222255]] 『マクロについて』（ヤイリ） ページの最後に飛ぶ

[[20100531222255]]　『マクロについて』（ヤイリ）　ページの最後に飛ぶ