[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『kana2roma.basの改訂』（ki9）
[エクセルの学校連絡用サイト]にコメントで書き込まれた物です。
本日始めて「エクセルの学校」を拝見させていただきました。とてもよくまとまっていますし、 強力な回答者さんの方々もいらっしゃり質の高い情報が集まっていて、素晴らしいです。 大変参考になりました！
実は本日、カナをローマ字に変化するVBAを誰か作っていてくれないかなと (他力本願です^^;)検索していたところ「エクセルの学校」を見つけました！
「エクセルの学校」- ダウンロード より (8) カタカナローマ字変換[ヘボン式] - kana2roma.lzh
をダウンロードさせて頂きました！とても素晴らしいですね。 なおさん、sousuiさんに感謝です。 ただ一つ、[kana2roma.bas]内のバグ（というほどでもないのですが）を見つけたので報告致します。 （既出でしたらスミマセン）
発生問題：マクロ実行時、「ﾘｬ」「ﾘｭ」「ﾘｮ」がすべて「RI」になってしまう 原因箇所：変換表「ﾘ」の部分の「End Select文」の後に「R = "RI"」がある 改善方法：End Select文の後の「R = "RI"」を削除する
とても有益なマクロであると思いますので、修正版のUPを是非よろしくお願いします！
Case "ﾘ"
Select Case mozi2
Case "ｬ"
R = "RYA"
i = i + 1
Case "ｭ"
R = "RYU"
i = i + 1
Case "ｮ"
R = "RYO"
i = i + 1
Case Else
R = "RI"
End Select
R = "RI"
の最後の R = "RI" ですね。 これを削除すれば治ると思いますが、作者の方は見てないかなぁ・・・。 (Mook)
これは単に消し忘れですかね？
私は意味があって、書いてあるのかなと...。
うーん ﾘｬ ﾘｭ ﾘｮ 以外の ﾘ ね。でもELSEもあることだし...。
（kazu）
現状ではSelectの中の処理がまったく無視されて、結局 RI に上書きされてました。
実験した結果ですが、 ﾘｬﾘｭﾘｮ を変換すると RIRIRI になります。 最後の行を消して実行すると RYARYURYO になりました。 (Mook)
UDF版で似たようなものですが、いかがでしょうか？
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
(ROUGE)
[Mook]さんありがとう、[ROUGE]さんもUDF版ありがとう。
とりあえず、元のファイルを残して改訂版をアップしました。
https://www.excel.studio-kazu.jp/DL/#q08
改訂版が見えない場合、ブラウザーの[更新]ボタンを押してみてください。
（kazu）
カタカナローマ字変換[ヘボン式]を
利用させていただきました。
本当に助かりました。
ありがとうございます。
ヒャ、ヒョ、ヒョの変換も
うまくいっていないようです。
もしよろしければ改定を
おねがいしてもよろしいでしょうか？
[櫻井]
「ヒャ、ヒョ、ヒョの変換を追加した版」
↓
'Attribute VB_Name = "Module11"
Sub 半角カタカナローマ字一括変換()
' おおむねヘボン式
' 長音表記は場合分けが難しいので文字の通りに変換
' （「しろうず」と書かれたときに しろ-うず と発音するのか，しろーず と発音するかは不明なので）
' 撥音はB,M,Pの前ではMになる。他はNに変換。
' 促音は子音を重ねて表記するが，子音がCだった場合は CTに。
' はっちょう → HATCHOU
' 長音記号は母音を重ねることにしているが，ヘボン式的にはたぶん無視するのが正しい。
Dim c As Range
Dim mozi, mozi1, mozi2, mozi3, moziR, R As String
Dim mozisuu As Integer
Dim sokuon, hatsuon As Boolean
'文字読み込み処理
For Each c In Selection
mozi = c.Value
If mozi = "" Then GoTo 90
mozisuu = Len(mozi)
'前より変換
For i = 1 To mozisuu
mozi1 = Mid(mozi, i, 1)
mozi2 = Mid(mozi, i + 1, 1)
mozi3 = Mid(mozi, i + 2, 1)
If Asc(mozi1) > 165 And Asc(mozi1) < 224 Then '半角カタカナかどうか判断
' 以下 変換表
Select Case mozi1
Case "ｯ" '促音だった場合
sokuon = 1
GoTo 30
Case "ﾝ" '撥音だった場合
hatsuon = 1
If i = mozisuu Then
R = N
Else
GoTo 30
End If
Case "ｰ" '長音記号
R = Right(moziR, 1) ' 一応，母音を重ねることにする
'R="" '長音記号は無視する場合
Case "ｱ"
R = "A"
Case "ｲ"
R = "I"
Case "ｳ"
R = "U"
Case "ｴ"
R = "E"
Case "ｵ"
R = "O"
Case "ｶ"
If mozi2 = "ﾞ" Then
R = "GA"
i = i + 1
Else
R = "KA"
End If
Case "ｷ"
Select Case mozi2
Case "ﾞ"
Select Case mozi3
Case "ｬ"
R = "GYA"
i = i + 2
Case "ｭ"
R = "GYU"
i = i + 2
Case "ｮ"
R = "GYO"
i = i + 2
Case Else
R = "GI"
i = i + 1
End Select
Case "ｬ"
R = "KYA"
i = i + 1
Case "ｭ"
R = "KYU"
i = i + 1
Case "ｮ"
R = "KYO"
i = i + 1
Case Else
R = "KI"
End Select
Case "ｸ"
If mozi2 = "ﾞ" Then
R = "GU"
i = i + 1
Else
R = "KU"
End If
Case "ｹ"
If mozi2 = "ﾞ" Then
R = "GE"
i = i + 1
Else
R = "KE"
End If
Case "ｺ"
If mozi2 = "ﾞ" Then
R = "GO"
i = i + 1
Else
R = "KO"
End If
Case "ｻ"
If mozi2 = "ﾞ" Then
R = "ZA"
i = i + 1
Else
R = "SA"
End If
Case "ｼ"
Select Case mozi2
Case "ﾞ"
Select Case mozi3
Case "ｬ"
R = "JA"
i = i + 2
Case "ｭ"
R = "JU"
i = i + 2
Case "ｮ"
R = "JO"
i = i + 2
Case Else
R = "JI"
i = i + 1
End Select
Case "ｬ"
R = "SHA"
i = i + 1
Case "ｭ"
R = "SHU"
i = i + 1
Case "ｮ"
R = "SHO"
i = i + 1
Case Else
R = "SHI"
End Select
Case "ｽ"
If mozi2 = "ﾞ" Then
R = "ZU"
i = i + 1
Else
R = "SU"
End If
Case "ｾ"
If mozi2 = "ﾞ" Then
R = "ZE"
i = i + 1
Else
R = "SE"
End If
Case "ｿ"
If mozi2 = "ﾞ" Then
R = "ZO"
i = i + 1
Else
R = "SO"
End If
Case "ﾀ"
If mozi2 = "ﾞ" Then
R = "DA"
i = i + 1
Else
R = "TA"
End If
Case "ﾁ"
Select Case mozi2
Case "ﾞ"
Select Case mozi3
Case "ｬ"
R = "JA"
i = i + 2
Case "ｭ"
R = "JU"
i = i + 2
Case "ｮ"
R = "JO"
i = i + 2
Case Else
R = "JI"
i = i + 1
End Select
Case "ｬ"
R = "CHA"
i = i + 1
Case "ｭ"
R = "CHU"
i = i + 1
Case "ｮ"
R = "CHO"
i = i + 1
Case Else
R = "CHI"
End Select
Case "ﾂ"
If mozi2 = "ﾞ" Then
R = "ZU"
i = i + 1
Else
R = "TSU"
End If
Case "ﾃ"
If mozi2 = "ﾞ" Then
R = "DE"
i = i + 1
Else
R = "TE"
End If
Case "ﾄ"
If mozi2 = "ﾞ" Then
R = "DO"
i = i + 1
Else
R = "TO"
End If
Case "ﾅ"
R = "NA"
Case "ﾆ"
Select Case mozi2
Case "ｬ"
R = "NYA"
i = i + 1
Case "ｭ"
R = "NYU"
i = i + 1
Case "ｮ"
R = "NYO"
i = i + 1
Case Else
R = "NI"
End Select
Case "ﾇ"
R = "NU"
Case "ﾈ"
R = "NE"
Case "ﾉ"
R = "NO"
Case "ﾊ"
Select Case mozi2
Case "ﾞ"
R = "BA"
i = i + 1
Case "ﾟ"
R = "PA"
i = i + 1
Case Else
R = "HA"
End Select
Case "ﾋ"
Select Case mozi2
Case "ﾞ"
Select Case mozi3
Case "ｬ"
R = "BYA"
i = i + 2
Case "ｭ"
R = "BYU"
i = i + 2
Case "ｮ"
R = "BYO"
i = i + 2
Case Else
R = "BI"
i = i + 1
End Select
Case "ﾟ"
Select Case mozi3
Case "ｬ"
R = "PYA"
i = i + 2
Case "ｭ"
R = "PYU"
i = i + 2
Case "ｮ"
R = "PYO"
i = i + 2
Case Else
R = "PI"
i = i + 1
End Select
Case "ｬ"
R = "HYA"
i = i + 1
Case "ｭ"
R = "HYU"
i = i + 1
Case "ｮ"
R = "HYO"
i = i + 1
Case Else
R = "HI"
End Select
Case "ﾌ"
Select Case mozi2
Case "ﾞ"
R = "BU"
i = i + 1
Case "ﾟ"
R = "PU"
i = i + 1
Case Else
R = "FU"
End Select
Case "ﾍ"
Select Case mozi2
Case "ﾞ"
R = "BE"
i = i + 1
Case "ﾟ"
R = "PE"
i = i + 1
Case Else
R = "HE"
End Select
Case "ﾎ"
Select Case mozi2
Case "ﾞ"
R = "BO"
i = i + 1
Case "ﾟ"
R = "PO"
i = i + 1
Case Else
R = "HO"
End Select
Case "ﾏ"
R = "MA"
Case "ﾐ"
Select Case mozi2
Case "ｬ"
R = "MYA"
i = i + 1
Case "ｭ"
R = "MYU"
i = i + 1
Case "ｮ"
R = "MYO"
i = i + 1
Case Else
R = "MI"
End Select
Case "ﾑ"
R = "MU"
Case "ﾒ"
R = "ME"
Case "ﾓ"
R = "MO"
Case "ﾔ"
R = "YA"
Case "ﾕ"
R = "YU"
Case "ﾖ"
R = "YO"
Case "ﾗ"
R = "RA"
Case "ﾘ"
Select Case mozi2
Case "ｬ"
R = "RYA"
i = i + 1
Case "ｭ"
R = "RYU"
i = i + 1
Case "ｮ"
R = "RYO"
i = i + 1
Case Else
R = "RI"
End Select
' R = "RI"
Case "ﾙ"
R = "RU"
Case "ﾚ"
R = "RE"
Case "ﾛ"
R = "RO"
Case "ﾜ"
R = "WA"
Case "ｦ"
R = "WO"
Case "ﾝ"
R = "N"
Case Else
R = "?"
End Select Else R = mozi1 End If '' 変換表 終了
If sokuon = True Then '促音処理
sokuon = 0
If Left(R, 1) = "C" Then
R = "T" + R
Else
R = Left(R, 1) + R
End If
End If
If hatsuon = True Then '撥音処理
hatsuon = 0
If Left(R, 1) = "B" Or Left(R, 1) = "M" Or Left(R, 1) = "P" Then
R = "M" + R
Else
R = "N" + R
End If
End If
moziR = moziR & R
30: Next i
' 変換結果記載
c.Value = moziR '上書き書き換え
moziR = "" '変換文字リセット
90: Next
MsgBox "処理が終りました。", vbInformation, "進行状況"
End Sub
気が付くのが遅くなりました、申し訳ないです。
検証テストをしています、少し待ってください。
（kazu）2012/01/24 01:09
遅くなりました。
[櫻井]さんの ﾋｬﾋｭﾋｮ 改訂版をダウンロード・ページにアップロードしました。
https://www.excel.studio-kazu.jp/DL/#q08
なぜか、漏れていた[ROUGE]さんのUDF版(申し訳ないです)も含めて、
今までのすべてのコードを組み込みました。
もし表示されていなかったら、ブラウザーの [更新] ボタンを押してください。
（kazu）2012/01/24 22:06
ありがとうございました。
（櫻井）2012/02/01
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.