エクセルのデータにふりがなを付けたい（英字・漢字・カナを含む）

エクセル等で作成したリストで、名前や会社名などを自動変換でふりがなを付けるにはどのようにしたら良いか教えてください。

・英字、カタカナ、漢字が含んでいる
・エクセルのふりがな機能ではなく、別のセルで表示する
・マクロやフリーソフトなどで、一括して変換できる

例） ABC田中ファイナンス → エービーシータナカファイナンス


以下のURLを参照していたのですが、マクロ等の知識がないためうまく出来ません。
漢字→カタカナ、英字→カタカナは以下のURLで出来ましたが、漢字や英字が含まれると
上記例のように変換できず困っています。

・http://ameblo.jp/myamya3365/entry-11508546288.html
・http://oshiete.goo.ne.jp/qa/1263072.html
・http://q.hatena.ne.jp/1172632091

恐れ入りますが、宜しくお願い致します。

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2015/06/29 23:47

本来は、別の言語が得意とする分野ですが、残念ながら、Perl系は途中で挫折しましたので、詳しくは私は知りません。

たぶん専門のツールがあったような気がします。特に、視覚障害者用の点字変換ソフトには、この種の機能が備わっています。また、正規表現置換の分野ですから、く込みタイプライブラリを使えば、もう少しマシなコードになります。VBAは、ほんの真似事にしかすぎません。

Windows版ソフト →ダブリュアイエヌディオウダブリュエスハンソフト　
ということで、本来は、英語を読み下すための辞書が必要なのですが、膨大な大きさになってしまいます。
なお、漢字、英字、数字の間には、半角スペースを入れることは可能です。
例：
buf = buf & " " & Application.GetPhonetic(m)
のようにします。

マクロ名は、WordingMacro　としました。読みをつけることを、英語で、Wordingといいますが、Wordの機能にあったような気がします。また、数字の読み下しには、桁を入れた別の読み方があります。

私は、ローマ字変換を作ったことがありますが、今回は、リンク先のマクロは、参考にさせていただきました。

範囲を選択してから、実行してください。
'//
'Option Explicit

Const strAlphaTarget As String = "abcdefghijklmnopqrstuvwxyz"
Const strAlphaYomi As String = "エイ,ビー,シー,ディ,イー,エフ,ジー,エイチ,アイ,ジェイ,ケイ,エル,エム,エヌ,オウ,ピー,キュウ,アール,エス,ティ,ユウ,ブイ,ダブリュ,エックス,ワイ,ゼット"
Const strNumTarget As String = "0123456789"
Const strNumYomi As String = "ゼロ,イチ,ニ,サン,ヨン,ゴ,ロク,ナナ,ハチ,キュウ"
Dim alphaAr As Variant
Dim numAr As Variant
Function Alpha2KaNa(ByVal strTxt As String)
Dim buf As String
Dim i As Long, j As Long
Dim etx As Variant
　strTxt = StrConv(strTxt, vbNarrow + vbLowerCase)
　If IsEmpty(alphaAr) Then
　 alphaAr = Split(strAlphaYomi, ",")
　End If
　For i = 1 To Len(strTxt)
　 etx = Mid(strTxt, i, 1)
　 If etx Like "[a-z]" Then
　　　j = Asc(etx) - 97
　　　buf = buf & alphaAr(j)
　 End If
　Next i
　Alpha2KaNa = buf
End Function

Function Num2Kana(ByVal strTxt As String)
Dim buf As String
Dim i As Long
Dim etx As Variant
　strTxt = StrConv(strTxt, vbNarrow + vbLowerCase)
　If IsEmpty(numAr) Then
　 numAr = Split(strNumYomi, ",")
　End If
　For i = 1 To Len(strTxt)
　 etx = Mid(strTxt, i, 1)
　 If etx Like "[0-9]" Then
　　　buf = buf & numAr(CInt(etx))
　 End If
　Next i
　Num2Kana = buf
End Function

Sub WordingMacro() '実行プログラム
'No. 9012486
　Dim strTxt As String
　Dim rng As Range
　Dim c As Variant
　Dim Matches As Object
　Dim m As Variant
　Dim tx As String
　Dim buf As String
　With CreateObject("VBScript.RegExp")
　　.Pattern = "[一-龠]+|[\d０-９]+|[A-Za-z]+|[ぁ-んァ-ヶ]+|[ 　ー]"
　　.Global = True
　　.IgnoreCase = False
　　'変換する範囲を選択してください
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　Set rng = Selection
　　For Each c In rng
　　　If c <> "" Then
　　　　strTxt = c.Text
　　　　Set Matches = .Execute(strTxt)
　　　　For Each m In Matches
　　　　　tx = StrConv(Mid(m, 1, 1), vbNarrow)
　　　　　If Asc(tx) < 0 Then
　　　　　　buf = buf & Application.GetPhonetic(m)
　　　　　ElseIf Asc(tx) < 58 Then
　　　　　　buf = buf & Num2Kana(m)
　　　　　ElseIf Asc(tx) < 123 Then
　　　　　　buf = buf & Alpha2KaNa(m)
　　　　　ElseIf Asc(tx) < 222 Then
　　　　　　buf = buf & StrConv(m, vbWide + vbKatakana)
　　　　　Else
　　　　　　buf = buf & " "
　　　　　End If
　　　　Next m
　　　　If Len(buf) > 2 Then
　　　　　c.Offset(, 1).Value = buf
　　　　End If
　　　　buf = ""
　　　End If
　　Next c
　End With
End Sub
'///

この回答へのお礼

長いコードを作成頂き誠に有難うございました。

私の希望に一番近く早速試させて頂き、問題なく動作致しました。
これで数千件あったリストがものの数秒で解決致しました。
改めて御礼申し上げます。

お礼日時：2015/06/30 09:55

No.1 回答者： tom04 回答日時： 2015/06/29 22:32

こんばんは！

一案です。

↓の画像のように別Sheetにアルファベットの読みの対応表を作成しておきます。
（画像ではSheet2に作っています）

そうした上でのVBAでの一例です。
A列データをB列に表示するようにしてみました。
標準モジュールにしてみてください。

Sub Sample1()
Dim i As Long, lastRow As Long, k As Long
Dim str As String, buf As String, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
With Range(.Cells(1, "B"), .Cells(lastRow, "B"))
.Formula = "=PHONETIC(A1)"
.Value = .Value
End With
For i = 1 To lastRow
For k = 1 To Len(.Cells(i, "B"))
str = Mid(.Cells(i, "B"), k, 1)
buf = UCase(StrConv(str, vbNarrow))
If buf Like "[A-Z]" Then
Set c = wS.Range("A:A").Find(what:=buf, LookIn:=xlValues, lookat:=xlWhole)
.Cells(i, "B") = Replace(.Cells(i, "B"), str, c.Offset(, 1))
End If
Next k
Next i
End With
End Sub

※　A列データは直接入力しているデータとします。
どこかのデータをコピー＆ペーストしている場合、
漢字の読みがお望み通りにならないコトがあります。

まずはこの程度で・・・m(_ _)m

この回答へのお礼

早速試させて頂きました。こちらのコードであれば、英字やカタカナだけでなくいろいろな置換が出来そうでかなり便利ですね。

早々にご回答頂き誠に有難うございました。

お礼日時：2015/06/30 09:09