• 利用VBA来实现,输入日文之后,输出它的假名即读法


    背景:当你输日文汉字的额时候,输出它的读音。

    如下图所示

    实现的代码如下

    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
    

      

  • 相关阅读:
    网络基础
    关于actionscript中新建一个sprite,设置大小(宽高)的问题。
    Android SDK无法更新问题解决 ---- 还可解决无法上google的问题
    android apk简单反编译
    Flash的坑之ExternalInterface.call只返回null值的解决办法
    Flash Socket简单调试工具
    进制转换 正进制
    Codeforces Div3 #498 A-F
    UVa10082
    div与div之间的拖拽
  • 原文地址:https://www.cnblogs.com/killclock048/p/11097954.html
Copyright © 2020-2023  润新知