http://yanok.net/dist/romaji-chimei-csv/
http://www.post.japanpost.jp/zipcode/dl/readme_ro.html
この辺から変換ﾃｰﾌﾞﾙ作ってvlookupで引っ張ってくる､というのはどうでしょうか｡
ただ､｢ヶ｣｢ｹ｣だとか政令指定都市の区名の扱いとか､あと長音や促音､撥音の扱いとかの問題はあるかもしれません｡
あと､ﾃﾞｰﾀ量がﾃﾞｰﾀ量なので､自動再計算は切って､変換後に｢値で貼り付け｣で固定化した方が良いかもしれません｡

住所の郵便番号(ﾛｰﾏ字･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件で十?数十秒のﾚﾍﾞﾙで処理が完了すると思います｡