提取汉字拼音首字符

以下是测试模块

Sub 测试()
  Dim str$
  str = InputBox("请输入要识别的字符串")
  MsgBox str & "的拼音首字母为:" & vbCr & vbCr & getPY(str)
End Sub

以下是功能实现模块


Function PinYin(str As String) As String
  Select Case Asc(str)
    Case -20319 To -20284: PinYin = "A"
    Case -20283 To -19776: PinYin = "B"
    Case -19775 To -19219: PinYin = "C"
    Case -19218 To -18711: PinYin = "D"
    Case -18710 To -18527: PinYin = "E"
    Case -18526 To -18240: PinYin = "F"
    Case -18239 To -17923: PinYin = "G"
    Case -17922 To -17418: PinYin = "H"
    Case -17417 To -16475: PinYin = "J"
    Case -16474 To -16213: PinYin = "K"
    Case -16212 To -15641: PinYin = "L"
    Case -15640 To -15166: PinYin = "M"
    Case -15165 To -14923: PinYin = "N"
    Case -14922 To -14915: PinYin = "O"
    Case -14914 To -14631: PinYin = "P"
    Case -14630 To -14150: PinYin = "Q"
    Case -14149 To -14091: PinYin = "R"
    Case -14090 To -13319: PinYin = "S"
    Case -13318 To -12839: PinYin = "T"
    Case -12838 To -12557: PinYin = "W"
    Case -12556 To -11848: PinYin = "X"
    Case -11847 To -11056: PinYin = "Y"
    Case -11055 To -2050: PinYin = "Z"
    Case Else: PinYin = str
  End Select
End Function

Function getPY(str)
  Dim i%
  For i = 1 To Len(str)
    getPY = getPY & PinYin(Mid(str, i, 1))
  Next i
End Function

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值