Access技巧接龙

ntcat

关于取得汉字的第一个拼音字母的函数,推荐使用我的GetPyAbOfHz函数.速度比上述HZPY快一倍. 不信? 测试代码附后Public Function GetFirstChr(ByVal sSrc As String)

    Dim sTemp As String

    sTemp = Left(sSrc, 1)

Select Case Asc(sTemp)

    Case 48 To 122

         GetFirstChr = sTemp

    Case Is >= Asc("匝")

         GetFirstChr = "Z"

    Case Is >= Asc("压")

         GetFirstChr = "Y"

    Case Is >= Asc("昔")

         GetFirstChr = "X"

    Case Is >= Asc("挖")

         GetFirstChr = "W"

    Case Is >= Asc("塌")

         GetFirstChr = "T"

    Case Is >= Asc("撒")

         GetFirstChr = "S"

    Case Is >= Asc("然")

         GetFirstChr = "R"

    Case Is >= Asc("期")

         GetFirstChr = "Q"

    Case Is >= Asc("啪")

         GetFirstChr = ""

    Case Is >= Asc("哦")

         GetFirstChr = "O"

    Case Is >= Asc("拿")

         GetFirstChr = "N"

    Case Is >= Asc("妈")

         GetFirstChr = "M"

    Case Is >= Asc("垃")

         GetFirstChr = "L"

    Case Is >= Asc("喀")

         GetFirstChr = "K"

    Case Is >= Asc("击")

         GetFirstChr = "J"

    Case Is >= Asc("哈")

         GetFirstChr = "H"

    Case Is >= Asc("噶")

         GetFirstChr = "G"

    Case Is >= Asc("发")

         GetFirstChr = "F"

    Case Is >= Asc("蛾")

         GetFirstChr = "E"

    Case Is >= Asc("搭")

         GetFirstChr = "D"

    Case Is >= Asc("擦")

         GetFirstChr = "C"

    Case Is >= Asc("芭")

         GetFirstChr = "B"

    Case Is >= Asc("啊")

         GetFirstChr = "A"

    Case Else

         GetFirstChr = "0"

End Select

End Function

'取得汉字的拼音缩写

Public Function GetPyAbOfHz(ByVal sHz As String) As String

    Dim sTmp, ch As String

    Dim i As Integer

    For i = 1 To Len(sHz)

        ch = Mid(sHz, i, 1)

        Select Case ch

            Case ".", "(", ")", "+", "-"

                sTmp = sTmp & ch

            Case " "

            Case Else

                sTmp = sTmp & GetFirstChr(ch)

        End Select

    Next

    GetPyAbOfHz = sTmp

End Function

'----------------------------------------速度测试代码:---------Public Sub speed_HZPY()

    Dim a1 As Single

        Dim i As Long    a1 = Timer

    For i = 1 To 66542

        HZPY ("地要不是在遥呐喊浊夺标炽烈二有遥感地于规划")

    Next

    Debug.Print Timer - a1

End Sub

Public Sub SPEED_GetPyAbOfHz()

    Dim a1 As Single

    Dim i As Long

    a1 = Timer

    For i = 1 To 66542

        GetPyAbOfHz ("地要不是在遥呐喊浊夺标炽烈二有遥感地于规划")

    Next

    Debug.Print Timer - a1

   

End Sub