背景:当你输日文汉字的额时候,输出它的读音。
如下图所示
实现的代码如下
Option Explicit ' Replace を まとめて おこなう Private Function ReplaceA(ByVal s As String, ByVal t1 As String, ByVal t2 As String) As String Dim u1() As String: u1 = Split(t1) Dim u2() As String: u2 = Split(t2) Dim i As Integer For i = 0 To UBound(u1) s = Replace(s, u1(i), u2(i)) Next ReplaceA = s End Function ' カタカナを ローマ字(英語式)に おきかえる Public Function KatakanaToRoomaziE(ByVal s As String) As String ' 前処理 s = ReplaceA(s, "ッン", "'ン") ' 拗音・特殊音 s = ReplaceA(s, "キャ キュ キョ", "kya kyu kyo") s = ReplaceA(s, "シャ シュ ショ", "sha shu sho") s = ReplaceA(s, "チャ チュ チョ", "cha chu cho") s = ReplaceA(s, "ニャ ニュ ニョ", "nya nyu nyo") s = ReplaceA(s, "ヒャ ヒュ ヒョ", "hya hyu hyo") s = ReplaceA(s, "ミャ ミュ ミョ", "mya myu myo") s = ReplaceA(s, "リャ リュ リョ", "rya ryu ryo") s = ReplaceA(s, "ギャ ギュ ギョ", "gya gyu gyo") s = ReplaceA(s, "ジャ ジュ ジョ", "ja ju jo") s = ReplaceA(s, "ヂャ ヂュ ヂョ", "ja ju jo") s = ReplaceA(s, "ビャ ビュ ビョ", "bya byu byo") s = ReplaceA(s, "ピャ ピュ ピョ", "pya pyu pyo") ' 直音 s = ReplaceA(s, "ア イ ウ エ オ", "a i u e o") s = ReplaceA(s, "カ キ ク ケ コ", "ka ki ku ke ko") s = ReplaceA(s, "サ シ ス セ ソ", "sa shi su se so") s = ReplaceA(s, "タ チ ツ テ ト", "ta chi tsu te to") s = ReplaceA(s, "ナ ニ ヌ ネ ノ", "na ni nu ne no") s = ReplaceA(s, "ハ ヒ フ ヘ ホ", "ha hi fu he ho") s = ReplaceA(s, "マ ミ ム メ モ", "ma mi mu me mo") s = ReplaceA(s, "ヤ ユ ヨ", "ya yu yo") s = ReplaceA(s, "ラ リ ル レ ロ", "ra ri ru re ro") s = ReplaceA(s, "ワ ヰ ヱ ヲ", "wa i e o") s = ReplaceA(s, "ガ ギ グ ゲ ゴ", "ga gi gu ge go") s = ReplaceA(s, "ザ ジ ズ ゼ ゾ", "za ji zu ze zo") s = ReplaceA(s, "ダ ヂ ヅ デ ド", "da ji zu de do") s = ReplaceA(s, "バ ビ ブ ベ ボ", "ba bi bu be bo") s = ReplaceA(s, "パ ピ プ ペ ポ", "pa pi pu pe po") ' 撥音 s = Replace(s, "ン", "n") s = ReplaceA(s, "nb nm np", "mb mm mp") ' 促音 s = ReplaceA(s, "ッk ッs ッt ッn ッh ッm ッy ッr ッw", "kk ss tt nn hh mm yy rr ww") s = ReplaceA(s, "ッg ッz ッd ッb ッp", "gg zz dd bb pp") s = ReplaceA(s, "ッc ッf ッj", "tc ff jj") s = Replace(s, "ッ", "'") ' 長音 s = Replace(s, "iー", "ii") s = Replace(s, "ー", "") KatakanaToRoomaziE = StrConv(StrConv(s, vbNarrow), vbLowerCase) End Function ' EOF Function GetPhonetic(セル As Range, _ Optional ByVal 変換 As Integer = 8, _ Optional ByVal 全て As Boolean = False) Dim strPhonetic As String GetPhonetic = StrConv(Application.GetPhonetic(セル), 変換) strPhonetic = GetPhonetic If 全て = True Then Do Until strPhonetic = "" strPhonetic = StrConv(Application.GetPhonetic(), 変換) If strPhonetic <> "" Then GetPhonetic = GetPhonetic & " ; " & strPhonetic End If Loop End If End Function Function DelAIUEO(ByVal romaStr As String) As String Dim delStr As String delStr = romaStr delStr = Replace(delStr, "A", "") delStr = Replace(delStr, "I", "") delStr = Replace(delStr, "U", "") delStr = Replace(delStr, "E", "") delStr = Replace(delStr, "O", "") delStr = Replace(delStr, "a", "") delStr = Replace(delStr, "i", "") delStr = Replace(delStr, "u", "") delStr = Replace(delStr, "e", "") delStr = Replace(delStr, "o", "") DelAIUEO = delStr End Function