• 利用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
    

      

  • 相关阅读:
    反向代理实例
    nginx常用命令和配置
    nginx的安装
    Can Live View boot up images acquired from 64bit OS evidence?
    What is the behavior of lnk files?
    EnCase v7 search hits in compound files?
    How to search compound files
    iOS 8.3 JB ready
    Sunglasses
    现代福尔摩斯
  • 原文地址:https://www.cnblogs.com/killclock048/p/11097954.html
Copyright © 2020-2023  润新知