如何用vba实现中文汉字转拼音,并且带声调?

用vba实现中文汉字转拼音,网上有很多帖子。

总结了下,大概可以分为以下3种:

  1. 预先内置汉字拼音字典,然后再匹配生成拼音,这个方法对多音字无法准确识别;
  2. 利用微软拼音输入法库,生成拼音,这个方法需要安装有微软拼音输入法;
  3. 利用网络数据采集,生成拼音,这个方法可以识别多音字,但是速度和效率不高。

今天,介绍利用网络数据采集,生成拼音的方案,通过网抓,可以利用大平台的大数据库,对多音字也有较好的兼容,唯一的缺点就是速度较慢,数据量大了以后还可能被禁止IP。

以下是在vba中利用汉字拼音在线转换

实现中文汉字转拼音的自定义函数,可以较为完美地解决多音字的问题,同时可以生成声调:

Function HZ2PY(ByVal sHZ As String)
    If Len(sHZ) Then
    Dim oHtml As Object
    Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
    Dim sUrl As String
    '指定要抓取的网站
    sUrl = "https://www.qqxiuzi.cn/zh/pinyin/"
    Dim sCharset As String
    '指定要抓取的网站的字符编码
    sCharset = "utf-8"
    With oHtml
        .Open "GET", sUrl, False
        .send
        '获取返回的字节数组
        bResult = .ResponseBody
        '按照指定的字符编码显示
        sResult = Byte2String(bResult, sCharset)
'        Debug.Print sResult
        sToken = Split(Split(sResult, "token=")(1), "'")(0)
        '指定要抓取的网站
        sUrl = "https://www.qqxiuzi.cn/zh/pinyin/show.php"
        Dim sText As String
        sText = "t=" & sHZ & "&d=1&s=1&k=1&b=null&h=null&u=null&v=null&y=null&z=null&f=null&token=" & sToken
        .Open "POST", "https://www.qqxiuzi.cn/zh/pinyin/show.php", False
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .send sText
        '获取返回的字节数组
        bResult = .ResponseBody
        '按照指定的字符编码显示
        sResult = Byte2String(bResult, sCharset)
         Set oHtmlDom = CreateObject("htmlfile")
        With oHtmlDom
            .body.innerHTML = sResult
            '获取汉字的拼音
            HZ2PY = .getElementsByTagName("div")(0).innertext
        End With
    '        Debug.Print sResult
    End With
    Set oHtml = Nothing
    Else
        HZ2PY = ""
    End If
End Function
Function Byte2String(bContent, ByVal sCharset As String)
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeRead = 1
    Const adModeWrite = 2
    Const adModeReadWrite = 3
    Dim oStream As Object
    '创建流对象
    Set oStream = CreateObject("ADODB.Stream")
    With oStream
        '打开流
        .Open
        '设置为字节模式
        .Type = adTypeBinary
        '写入字节
        .write bContent
        '将位置定位在第一个字节
        .Position = 0
        '设置为文本模式
        .Type = adTypeText
        '设置编码的字符集
        .Charset = sCharset
        '读取编码后的文本
         Byte2String = .ReadText
        '关闭流对象
        .Close
    End With
End Function

以上代码利用WinHttpRequest对象进行网站数据采集。

       

发表评论