如何实现一段文字转换为拼音字头？

Question

现有一问题请教，为实现字段内容查询方便，现准备把商品资料中品名字段转为汉语拼音字头缩写形式体现做为一新字段内容。请各位不吝赐教！！！！！！！！！！！

Answer 1

Public Function GetPY(a1 As String) As String                                   '返回拼音码字符串
    
    '输入参数:a1 输入字符串
    
    Dim Jsqte As Long
    Dim t1 As String
    GetPY = ""
    If Len(Trim(a1)) = 0 Then
        Exit Function
    End If
    For Jsqte = 1 To Len(Trim(a1))
        t1 = Mid(a1, Jsqte, 1)
        If Asc(t1) < 0 Then
            If Asc(t1) < Asc("啊") Then
                GetPY = GetPY + t1
                GoTo L1
            End If
            If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
                GetPY = GetPY + "A"
                GoTo L1
            End If
            If Asc(t1) >= Asc("芭") And Asc(t1) < Asc("擦") Then
                GetPY = GetPY + "B"
                GoTo L1
            End If
            If Asc(t1) >= Asc("擦") And Asc(t1) < Asc("搭") Then
                GetPY = GetPY + "C"
                GoTo L1
            End If
            If Asc(t1) >= Asc("搭") And Asc(t1) < Asc("蛾") Then
                GetPY = GetPY + "D"
                GoTo L1
            End If
            If Asc(t1) >= Asc("蛾") And Asc(t1) < Asc("发") Then
                GetPY = GetPY + "E"
                GoTo L1
            End If
            If Asc(t1) >= Asc("发") And Asc(t1) < Asc("噶") Then
                GetPY = GetPY + "F"
                GoTo L1
            End If
            If Asc(t1) >= Asc("噶") And Asc(t1) < Asc("哈") Then
                GetPY = GetPY + "G"
                GoTo L1
            End If
            If Asc(t1) >= Asc("哈") And Asc(t1) < Asc("击") Then
                GetPY = GetPY + "H"
                GoTo L1
            End If
            If Asc(t1) >= Asc("击") And Asc(t1) < Asc("喀") Then
                GetPY = GetPY + "J"
                GoTo L1
            End If
            If Asc(t1) >= Asc("喀") And Asc(t1) < Asc("垃") Then
                GetPY = GetPY + "K"
                GoTo L1
            End If
            If Asc(t1) >= Asc("垃") And Asc(t1) < Asc("妈") Then
                GetPY = GetPY + "L"
                GoTo L1
            End If
            If Asc(t1) >= Asc("妈") And Asc(t1) < Asc("拿") Then
                GetPY = GetPY + "M"
                GoTo L1
            End If
            If Asc(t1) >= Asc("拿") And Asc(t1) < Asc("哦") Then
                GetPY = GetPY + "N"
                GoTo L1
            End If
            If Asc(t1) >= Asc("哦") And Asc(t1) < Asc("啪") Then
                GetPY = GetPY + "O"
                GoTo L1
            End If
            If Asc(t1) >= Asc("啪") And Asc(t1) < Asc("期") Then
                GetPY = GetPY + "P"
                GoTo L1
            End If
            If Asc(t1) >= Asc("期") And Asc(t1) < Asc("然") Then
                GetPY = GetPY + "Q"
                GoTo L1
            End If
            If Asc(t1) >= Asc("然") And Asc(t1) < Asc("撒") Then
                GetPY = GetPY + "R"
                GoTo L1
            End If
            If Asc(t1) >= Asc("撒") And Asc(t1) < Asc("塌") Then
                GetPY = GetPY + "S"
                GoTo L1
            End If
            If Asc(t1) >= Asc("塌") And Asc(t1) < Asc("挖") Then
                GetPY = GetPY + "T"
                GoTo L1
            End If
            If Asc(t1) >= Asc("挖") And Asc(t1) < Asc("昔") Then
                GetPY = GetPY + "W"
                GoTo L1
            End If
            If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("压") Then
                GetPY = GetPY + "X"
                GoTo L1
            End If
            If Asc(t1) >= Asc("压") And Asc(t1) < Asc("匝") Then
                GetPY = GetPY + "Y"
                GoTo L1
            End If
            If Asc(t1) >= Asc("匝") Then
                GetPY = GetPY + "Z"
                GoTo L1
            End If
        Else
            If UCase(t1) <= "Z" And UCase(t1) >= "A" Then
                GetPY = GetPY + UCase(t1)
            Else
                GetPY = t1
            End If
        End If
L1:
    Next Jsqte
    
End Function

Answer 2

'============================================================
'在工程中引用AutoPY.dll，然后就可以使用GetPY方法直接得到字符串对应的拼音输入码了。
'============================================================Option Explicit'初始化类模块
Private Sub Class_Initialize()
    
End SubPublic Function GetPY(strInput As String) As String
    
    Dim strResult    As String
    Dim iPos         As Integer
    
    '去除源字符串中的特殊字符
    strInput = Replace(strInput, " ", "")
    strInput = Replace(strInput, "[", "")
    strInput = Replace(strInput, "]", "")
    strInput = Replace(strInput, "'", "")
    
    strResult = ""
    
    For iPos = 1 To Len(strInput)
        strResult = strResult & GetOnePY(Mid(strInput, iPos, 1))
    Next
    
    GetPY = strResult
    
End Function
Private Function GetOnePY(strInput As String) As String
    
    Dim strTemp      As String
    
    '特殊字手工判断
    Select Case strInput
        Case "噢"
            GetOnePY = "O"
            Exit Function
            
        Case "杞", "芪"
            GetOnePY = "Q"
            Exit Function
            
        Case "嘌"
            GetOnePY = "P"
            Exit Function
            
        Case "呤"
            GetOnePY = "L"
            Exit Function
        
        Case "噁"
            GetOnePY = "_"
            Exit Function
            
    End Select
    
    If Asc(strInput) < 0 Then
        strTemp = Left(strInput, 1)
        
        If Asc(strTemp) < Asc("啊") Then
            If strTemp = "（" Then strTemp = "("
            If strTemp = "）" Then strTemp = ")"
            GetOnePY = strTemp
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("啊") And Asc(strTemp) < Asc("芭") Then
            GetOnePY = "A"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("芭") And Asc(strTemp) < Asc("擦") Then
            GetOnePY = "B"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("擦") And Asc(strTemp) < Asc("搭") Then
            GetOnePY = "C"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("搭") And Asc(strTemp) < Asc("蛾") Then
            GetOnePY = "D"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("蛾") And Asc(strTemp) < Asc("发") Then
            GetOnePY = "E"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("发") And Asc(strTemp) < Asc("噶") Then
            GetOnePY = "F"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("噶") And Asc(strTemp) < Asc("哈") Then
            GetOnePY = "G"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("哈") And Asc(strTemp) < Asc("击") Then
            GetOnePY = "H"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("击") And Asc(strTemp) < Asc("喀") Then
            GetOnePY = "J"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("喀") And Asc(strTemp) < Asc("垃") Then
            GetOnePY = "K"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("垃") And Asc(strTemp) < Asc("妈") Then
            GetOnePY = "L"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("妈") And Asc(strTemp) < Asc("拿") Then
            GetOnePY = "M"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("拿") And Asc(strTemp) < Asc("哦") Then
            GetOnePY = "N"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("哦") And Asc(strTemp) < Asc("啪") Then
            GetOnePY = "O"
            Exit Function
        End If
            
        If Asc(strTemp) >= Asc("啪") And Asc(strTemp) < Asc("期") Then
            GetOnePY = "P"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("期") And Asc(strTemp) < Asc("然") Then
            GetOnePY = "Q"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("然") And Asc(strTemp) < Asc("撒") Then
            GetOnePY = "R"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("撒") And Asc(strTemp) < Asc("塌") Then
            GetOnePY = "S"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("塌") And Asc(strTemp) < Asc("挖") Then
            GetOnePY = "T"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("挖") And Asc(strTemp) < Asc("昔") Then
            GetOnePY = "W"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("昔") And Asc(strTemp) < Asc("压") Then
            GetOnePY = "X"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("压") And Asc(strTemp) < Asc("匝") Then
            GetOnePY = "Y"
            Exit Function
        End If
        
        If Asc(strTemp) >= Asc("匝") Then
            GetOnePY = "Z"
            Exit Function
        End If
        
    Else
        
        If UCase(strInput) <= "Z" And UCase(strInput) >= "A" Then
            GetOnePY = UCase(Left(strInput, 1))
        Else
            GetOnePY = strInput
        End If
        
    End If
End Function

Answer 3

cobrastudio(老汉我) 的程序最为完美，其中解决了特殊字符及数字开头的问题。在次多谢各位楼上的赐教，请在以后学习的日子里多多帮助。

Answer 4

试了一下 cobrastudio(老汉我) 的程序，好象有的还不行，比如人名字是"李喆"（吉吉），第二个字是按原字返回的

Answer 5

最奇怪的是这个字的ASCII码是-31052，应该能返回一个字母啊