Excelの質問です。地名をローマ字に変換したいです。


前回の質問へのご回答 http://q.hatena.ne.jp/1479040277 で、市区町村を取得することが出来ました。そこからそれを、ローマ字に変えたいのですが。

Variable name creation | 漢字をローマ字・英語に変換します。変数名を作成するためのツールです。
http://hensumei.com/kanji-romaji

ですと、文字1つずつしか変換することが出来ません。
馴染み深いのでExcelで、一度に大量のデータをローマ字に変換できたらいいなと思っています。特にExcelにこだわっているわけではありませんが。

何らかの方法で多数の地名データをローマ字に変換できる方法をご教授いただけると助かります。
よろしくお願い致します。

回答の条件
  • 1人30回まで
  • 13歳以上
  • 登録:2016/11/20 18:04:21
  • 終了:2016/12/04 16:00:53

ベストアンサー

id:a-kuma3 No.2

a-kuma3回答回数4562ベストアンサー獲得回数19062016/12/01 00:05:44

ポイント2000pt

住所の郵便番号(ローマ字・zip形式)のデータを使って、表引きでやってみました。
以下の手順でやってみてください。

  1. 住所の郵便番号(ローマ字・zip形式)から ken_rome_all.zip をダウンロードします
  2. KEN_ALL_ROME.CSV を Excel で開いて、シートの「移動またはコピー」で目的の Book に "KEN_ALL_ROME" シートを移動する
    移動先の位置はどこでも構いません。シートの名前が KEN_ALL_ROME になっているはずです。
  3. 以下のコードを目的の Book の標準モジュールに貼り付けて、to_roman_by_list サブルーチンを実行してください
Sub to_roman_by_list()
    source_col = 1      ' A列 : 市区町村
    dest_col = 2        ' C列 : ローマ字

    key_col = 3         ' C列 : 漢字
    val_col = 6         ' F列 : ローマ字

    ' ローマ字読みを引き当てる辞書を作成する
    Set ps = Sheets("KEN_ALL_ROME")
    Set roman_map = CreateObject("Scripting.Dictionary")

    last_row = ps.Cells(Rows.Count, key_col).End(xlUp).Row
    For r = 1 To last_row
        k = ps.Cells(r, key_col).Value
        i = InStr(k, " ")
        If i <> 0 Then
            k = Left(k, i - 1)
        End If
        v = ps.Cells(r, val_col).Value
        i = InStr(v, " ")
        i = InStr(i + 1, v, " ")
        If i <> 0 Then
            v = Left(v, i - 1)
        End If
        If Not roman_map.exists(k) Then
            roman_map.Add k, v
        Else
            vv = roman_map(k)
            If v <> vv Then
                roman_map(k) = "★★"
            End If
        End If
    Next

    ' 辞書を使ってローマ字読みを書き込む
    start_row = 2
    last_row = Cells(Rows.Count, source_col).End(xlUp).Row
    Range(Cells(start_row, dest_col), Cells(last_row, dest_col)).Clear
    For r = start_row To last_row
        Roman = roman_map.Item(Cells(r, source_col).Value)
        If Roman = "" Then
            Roman = "★"
        End If
        Cells(r, dest_col).Value = Roman
    Next


    Set roman_map = Nothing
End Sub

A列の市区町村名のローマ字読みを B列にセットします。
処理が終わってしまえば、郵便番号データは必要ないので KEN_ALL_ROME のシートは削除しても構いません。

前回の質問では「郡」の場合には、町村ではなく「郡」を採用しているので、ローマ字読みも「郡」を対象にしています。

引き当てができない場合には、手で修正しても構わない、ということなので、以下のケースでは探しやすいように、★をローマ字読みの列に入れるようにしました。

  • 郵便番号データから引き当てられない場合には「★」が入ります。古い住所や東京都の「島」が該当します。
  • 郵便番号データで、表記は同じだが読みが異なる場合には「★★」が入ります。コメントで挙げた三通り、六つの郡が該当します。


数年前の並程度のノートPC で、9000件ほどを 5秒で処理できました。
環境にもよりますが、50000件で十~数十秒のレベルで処理が完了すると思います。

id:moon-fondu

ありがとうございます、5000件ぐらいのデータでa-kuma3さんのマクロを使うと一瞬でした!“愛知郡”も“★★”に変わりました!ありがとうございました<m(__)m>

2016/12/04 16:00:09

その他の回答(1件)

id:TransFreeBSD No.1

TransFreeBSD回答回数667ベストアンサー獲得回数2682016/11/21 01:04:56

ポイント50pt

http://yanok.net/dist/romaji-chimei-csv/
http://www.post.japanpost.jp/zipcode/dl/readme_ro.html
この辺から変換テーブル作ってvlookupで引っ張ってくる、というのはどうでしょうか。
ただ、「ヶ」「ケ」だとか政令指定都市の区名の扱いとか、あと長音や促音、撥音の扱いとかの問題はあるかもしれません。
あと、データ量がデータ量なので、自動再計算は切って、変換後に「値で貼り付け」で固定化した方が良いかもしれません。

id:moon-fondu

TransFreeBSDさん、コメントありがとうございます。それもありかもしれませんね。
romaji-chimei-all-uファイル開きました。D列とE列にローマ字表記が書いてくれてますね。
もしA列の地名に一致すれば、その3列隣のD列の値を引用する、って感じですね。

2016/11/22 22:30:30
id:a-kuma3 No.2

a-kuma3回答回数4562ベストアンサー獲得回数19062016/12/01 00:05:44ここでベストアンサー

ポイント2000pt

住所の郵便番号(ローマ字・zip形式)のデータを使って、表引きでやってみました。
以下の手順でやってみてください。

  1. 住所の郵便番号(ローマ字・zip形式)から ken_rome_all.zip をダウンロードします
  2. KEN_ALL_ROME.CSV を Excel で開いて、シートの「移動またはコピー」で目的の Book に "KEN_ALL_ROME" シートを移動する
    移動先の位置はどこでも構いません。シートの名前が KEN_ALL_ROME になっているはずです。
  3. 以下のコードを目的の Book の標準モジュールに貼り付けて、to_roman_by_list サブルーチンを実行してください
Sub to_roman_by_list()
    source_col = 1      ' A列 : 市区町村
    dest_col = 2        ' C列 : ローマ字

    key_col = 3         ' C列 : 漢字
    val_col = 6         ' F列 : ローマ字

    ' ローマ字読みを引き当てる辞書を作成する
    Set ps = Sheets("KEN_ALL_ROME")
    Set roman_map = CreateObject("Scripting.Dictionary")

    last_row = ps.Cells(Rows.Count, key_col).End(xlUp).Row
    For r = 1 To last_row
        k = ps.Cells(r, key_col).Value
        i = InStr(k, " ")
        If i <> 0 Then
            k = Left(k, i - 1)
        End If
        v = ps.Cells(r, val_col).Value
        i = InStr(v, " ")
        i = InStr(i + 1, v, " ")
        If i <> 0 Then
            v = Left(v, i - 1)
        End If
        If Not roman_map.exists(k) Then
            roman_map.Add k, v
        Else
            vv = roman_map(k)
            If v <> vv Then
                roman_map(k) = "★★"
            End If
        End If
    Next

    ' 辞書を使ってローマ字読みを書き込む
    start_row = 2
    last_row = Cells(Rows.Count, source_col).End(xlUp).Row
    Range(Cells(start_row, dest_col), Cells(last_row, dest_col)).Clear
    For r = start_row To last_row
        Roman = roman_map.Item(Cells(r, source_col).Value)
        If Roman = "" Then
            Roman = "★"
        End If
        Cells(r, dest_col).Value = Roman
    Next


    Set roman_map = Nothing
End Sub

A列の市区町村名のローマ字読みを B列にセットします。
処理が終わってしまえば、郵便番号データは必要ないので KEN_ALL_ROME のシートは削除しても構いません。

前回の質問では「郡」の場合には、町村ではなく「郡」を採用しているので、ローマ字読みも「郡」を対象にしています。

引き当てができない場合には、手で修正しても構わない、ということなので、以下のケースでは探しやすいように、★をローマ字読みの列に入れるようにしました。

  • 郵便番号データから引き当てられない場合には「★」が入ります。古い住所や東京都の「島」が該当します。
  • 郵便番号データで、表記は同じだが読みが異なる場合には「★★」が入ります。コメントで挙げた三通り、六つの郡が該当します。


数年前の並程度のノートPC で、9000件ほどを 5秒で処理できました。
環境にもよりますが、50000件で十~数十秒のレベルで処理が完了すると思います。

id:moon-fondu

ありがとうございます、5000件ぐらいのデータでa-kuma3さんのマクロを使うと一瞬でした!“愛知郡”も“★★”に変わりました!ありがとうございました<m(__)m>

2016/12/04 16:00:09
  • id:a-kuma3
    どの程度まで、精度を求めるでしょうか。
    前回の質問で分かりましたが、表引きだと昔の住所に弱いです。
    合併とか市制への移行とか、それなりにあります。

    後、市区町村を切り出した後に当てはめると、同じ表記で違う読みになるケースがあります。
    郵便番号のデータでいうと、以下の三つが都道府県を含めないと、正確に読みを求められません。
      愛知県:愛知郡 AICHI GUN
      滋賀県:愛知郡 ECHI GUN

      愛知県:海部郡 AMA GUN
      徳島県:海部郡 KAIFU GUN

      大阪府:三島郡 MISHIMA GUN
      新潟県:三島郡 SANTO GUN
  • id:moon-fondu
    a-kuma3さんコメントありがとうございます!
    都道府県名のカタカナが入っても構いません。

    昔の住所は漢字のままとかでもよいです。
    そんなにないような気もしますので、後で手修正するという方法で対応しようかなと思います。
    変えれるものだけローマ字になると助かります。
    よろしくお願い致します。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません