試作品のUDFです。
Alt+F11を押して、挿入-->標準モジュールを選択。
出てきた画面に下記コードをコピペして閉じる。
Excel画面に戻り、=RomanConv(A1) などと数式を入力します。
ひらがな、全角カタカナ、半角カタカナいずれもOKです。
--------------------------------------------------------
Function RomanConv(strMoto As String, Optional cho As Boolean = False) As String
Dim txt As String, i As Long, ans As String
txt = StrConv(StrConv(strMoto, vbKatakana), vbWide)
ans = ""
For i = 1 To Len(txt)
Select Case Mid(txt, i, 1)
Case "ア": ans = ans & "A"
Case "イ", "ヰ": ans = ans & "I"
Case "ウ": ans = ans & "U"
Case "エ", "ヱ": ans = ans & "E"
Case "オ": ans = ans & "O"
Case "カ": ans = ans & "KA"
Case "キ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "KYA"
i = i + 1
Case "ュ"
ans = ans & "KYU"
i = i + 1
Case "ョ"
ans = ans & "KYO"
i = i + 1
Case Else
ans = ans & "KI"
End Select
Case "ク": ans = ans & "KU"
Case "ケ": ans = ans & "KE"
Case "コ": ans = ans & "KO"
Case "サ": ans = ans & "SA"
Case "シ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "SHA"
i = i + 1
Case "ュ"
ans = ans & "SHU"
i = i + 1
Case "ョ"
ans = ans & "SHO"
i = i + 1
Case Else
ans = ans & "SHI"
End Select
Case "ス": ans = ans & "SU"
Case "セ": ans = ans & "SE"
Case "ソ": ans = ans & "SO"
Case "タ": ans = ans & "TA"
Case "チ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "CHA"
i = i + 1
Case "ュ"
ans = ans & "CHU"
i = i + 1
Case "ョ"
ans = ans & "CHO"
i = i + 1
Case Else
ans = ans & "CHI"
End Select
Case "ツ": ans = ans & "TSU"
Case "テ": ans = ans & "TE"
Case "ト": ans = ans & "TO"
Case "ナ": ans = ans & "NA"
Case "ニ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "NYA"
i = i + 1
Case "ュ"
ans = ans & "NYU"
i = i + 1
Case "ョ"
ans = ans & "NYO"
i = i + 1
Case Else
ans = ans & "NI"
End Select
Case "ヌ": ans = ans & "NU"
Case "ネ": ans = ans & "NE"
Case "ノ": ans = ans & "NO"
Case "ハ": ans = ans & "HA"
Case "ヒ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "HYA"
i = i + 1
Case "ュ"
ans = ans & "HYU"
i = i + 1
Case "ョ"
ans = ans & "HYO"
i = i + 1
Case Else
ans = ans & "HI"
End Select
Case "フ": ans = ans & "FU"
Case "ヘ": ans = ans & "HE"
Case "ホ": ans = ans & "HO"
Case "マ": ans = ans & "MA"
Case "ミ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "MYA"
i = i + 1
Case "ュ"
ans = ans & "MYU"
i = i + 1
Case "ョ"
ans = ans & "MYO"
i = i + 1
Case Else
ans = ans & "MI"
End Select
Case "ム": ans = ans & "MU"
Case "メ": ans = ans & "ME"
Case "モ": ans = ans & "MO"
Case "ヤ": ans = ans & "YA"
Case "ユ": ans = ans & "YU"
Case "ヨ": ans = ans & "YO"
Case "ラ": ans = ans & "RA"
Case "リ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "RYA"
i = i + 1
Case "ュ"
ans = ans & "RYU"
i = i + 1
Case "ョ"
ans = ans & "RYO"
i = i + 1
Case Else
ans = ans & "RI"
End Select
Case "ル": ans = ans & "RU"
Case "レ": ans = ans & "RE"
Case "ロ": ans = ans & "RO"
Case "ワ": ans = ans & "WA"
Case "ヲ": ans = ans & "WO"
Case "ン": ans = ans & "N"
Case "ガ": ans = ans & "GA"
Case "ギ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "GYA"
i = i + 1
Case "ュ"
ans = ans & "GYU"
i = i + 1
Case "ョ"
ans = ans & "GYO"
i = i + 1
Case Else
ans = ans & "GI"
End Select
Case "グ": ans = ans & "GU"
Case "ゲ": ans = ans & "GE"
Case "ゴ": ans = ans & "GO"
Case "ザ": ans = ans & "ZA"
Case "ジ", "ヂ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "JA"
i = i + 1
Case "ュ"
ans = ans & "JU"
i = i + 1
Case "ョ"
ans = ans & "JO"
i = i + 1
Case Else
ans = ans & "JI"
End Select
Case "ズ", "ヅ": ans = ans & "ZU"
Case "ゼ": ans = ans & "ZE"
Case "ゾ": ans = ans & "ZO"
Case "ダ": ans = ans & "DA"
Case "デ": ans = ans & "DE"
Case "ド": ans = ans & "DO"
Case "バ": ans = ans & "BA"
Case "ビ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "BYA"
i = i + 1
Case "ュ"
ans = ans & "BYU"
i = i + 1
Case "ョ"
ans = ans & "BYO"
i = i + 1
Case Else
ans = ans & "BI"
End Select
Case "ブ": ans = ans & "BU"
Case "ベ": ans = ans & "BE"
Case "ボ": ans = ans & "BO"
Case "パ": ans = ans & "PA"
Case "ピ"
Select Case Mid(txt, i + 1, 1)
Case "ャ"
ans = ans & "PYA"
i = i + 1
Case "ュ"
ans = ans & "PYU"
i = i + 1
Case "ョ"
ans = ans & "PYO"
i = i + 1
Case Else
ans = ans & "PI"
End Select
Case "プ": ans = ans & "PU"
Case "ペ": ans = ans & "PE"
Case "ポ": ans = ans & "PO"
Case "ッ": ans = ans & "@"
Case " ": ans = ans & " "
Case Else: ans = ans & "?"
End Select
Next
For i = 1 To Len(ans)
If Mid(ans, i, 1) = "@" Then _
ans = Left(ans, i - 1) & Mid(ans, i + 1, 1) & Mid(ans, i + 1)
Next
With WorksheetFunction
ans = .Substitute(ans, "NB", "MB")
ans = .Substitute(ans, "NM", "MM")
ans = .Substitute(ans, "NP", "MP")
ans = .Substitute(ans, "CC", "TC")
If cho Then
ans = .Substitute(ans, "AA", "A")
ans = .Substitute(ans, "II", "I")
ans = .Substitute(ans, "UU", "U")
ans = .Substitute(ans, "EE", "E")
ans = .Substitute(ans, "OO", "O")
ans = .Substitute(ans, "OU", "O")
End If
End With
RomanConv = ans
End Function
