ACCESS 汉字转成拼音首字母

发布时间 2023-10-12 16:42:51作者: 一曲轻扬
'拼音首字母
Public Function HZtoPY(ByVal strHZ As String) As String
    Dim i As Integer, intCountHZ As Integer
    Dim HZ As String

    strHZ = Trim(strHZ)
    intCountHZ = Len(strHZ)
    HZtoPY = ""

    For i = 1 To intCountHZ
        HZ = Mid(strHZ, i, 1)
        Select Case ChrW(AscW(HZ))
        Case ChrW(&H5416) To ChrW(&H93CA): HZtoPY = HZtoPY & "A"
        Case ChrW(&H516B) To ChrW(&H7C3F): HZtoPY = HZtoPY & "B"
        Case ChrW(&H5693) To ChrW(&H9519): HZtoPY = HZtoPY & "C"
        Case ChrW(&H54D2) To ChrW(&H8DFA): HZtoPY = HZtoPY & "D"
        Case ChrW(&H5C59) To ChrW(&H8D30): HZtoPY = HZtoPY & "E"
        Case ChrW(&H53D1) To ChrW(&H99A5): HZtoPY = HZtoPY & "F"
        Case ChrW(&H65EE) To ChrW(&H8FC7): HZtoPY = HZtoPY & "G"
        Case ChrW(&H94EA) To ChrW(&H8816): HZtoPY = HZtoPY & "H"
            '''' "I"  -- ?;T;
        Case ChrW(&H4E0C) To ChrW(&H7AE3): HZtoPY = HZtoPY & "J"
        Case ChrW(&H5494) To ChrW(&H5ED3): HZtoPY = HZtoPY & "K"
        Case ChrW(&H5783) To ChrW(&H96D2): HZtoPY = HZtoPY & "L"
        Case ChrW(&H5988) To ChrW(&H7A46): HZtoPY = HZtoPY & "M"
        Case ChrW(&H62FF) To ChrW(&H7CEF): HZtoPY = HZtoPY & "N"
        Case ChrW(&H5662) To ChrW(&H6CA4): HZtoPY = HZtoPY & "O"
        Case ChrW(&H8DB4) To ChrW(&H66DD): HZtoPY = HZtoPY & "P"
        Case ChrW(&H4E03) To ChrW(&H7FA4): HZtoPY = HZtoPY & "Q"
        Case ChrW(&H86BA) To ChrW(&H7BAC): HZtoPY = HZtoPY & "R"
        Case ChrW(&H7BAC) To ChrW(&H9501): HZtoPY = HZtoPY & "S"
        Case ChrW(&H4ED6) To ChrW(&H7BA8): HZtoPY = HZtoPY & "T"
            '''' "U"  -- ?;T;
            '''  "V"  -- ?;T;
        Case ChrW(&H54C7) To ChrW(&H92C8): HZtoPY = HZtoPY & "W"
        Case ChrW(&H5915) To ChrW(&H8548): HZtoPY = HZtoPY & "X"
        Case ChrW(&H8548) To ChrW(&H8574): HZtoPY = HZtoPY & "Y"
        Case ChrW(&H531D) To ChrW(&H505A): HZtoPY = HZtoPY & "Z"
        Case Else
            HZtoPY = HZtoPY & HZ
        End Select
    Next
End Function

调用 :

?HZtoPY("平刀")
'PD'