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