VB获取汉字首拼函数

获取单个汉字、英文、数字自定义函数如下

Public Function Py(mystr As String) As String  '获取单个汉字首拼函数,英文数字直接转大些显示

  If Asc(mystr) < 0 Then
    If Asc(Left(mystr, 1)) < Asc("啊") Then
       Py = "0"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then
       Py = "A"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then
       Py = "B"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then
       Py = "C"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then
       Py = "D"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then
       Py = "E"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then
       Py = "F"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then
       Py = "G"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then
       Py = "H"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then
       Py = "J"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then
       Py = "K"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then
       Py = "L"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then
       Py = "M"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then
       Py = "N"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then
       Py = "O"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then
       Py = "P"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then
       Py = "Q"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then
       Py = "R"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then
       Py = "S"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then
       Py = "T"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then
       Py = "W"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then
       Py = "X"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then
       Py = "Y"
       Exit Function
    End If
    If Asc(Left(mystr, 1)) >= Asc("匝") Then
       Py = "Z"
       Exit Function
    End If
  Else
    If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then
       Py = UCase(Left(mystr, 1))
      Else
       Py = mystr
    End If
  End If
End Function

可以再做一个自定义函数来获取汉字字符串首拼，注意需要配合上面的函数实现，其实就是封装了for循环调用。

Public Function autoPy(str As String) As String  '获取汉字字符串首拼，配合调用Py函数
Dim t As Integer
For t = 1 To Len(str)
    autoPy = autoPy & LCase(Py(Mid(str, t, 1)))
Next
End Function