[分享]在输入“济南”时，输入拼音代码“jn”就可以！！

zhaobeaut

文件下载
可以输入拼音代码来输入名称，，，，
并且在代码栏可以根据上面输入的车次自动选择到站！！！[em06]

李啸林

我还以为你的拼音代码“jn”，是自动生成的。原来是用一字段[简码]手工输入来实现。

zhaobeaut

那怎么能自动实现呢，,,,

acc

抄自别人处：不记得出处了。真对不起原作者
也许对你有用
取得汉字的拼音首字
用以下的函数可以得到汉字的拼音首字字符，注意：对 噢、杞、
嘌、呤 是个例外。
对很多汉字无法正确的实现转换，
原因是在该程序根据汉字在编码表中的位置来判断的，
而部分的汉字所在的位置有误，所以 。。。。
Public Function GetPY(a1 As String) As String
Dim t1 As String
If Asc(a1) < 0 Then
t1 = Left(a1, 1)
If Asc(t1) < Asc("啊") Then
GetPY = "0"
Exit Function
End If
If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
GetPY = "A"
Exit Function
End If
If Asc(t1) >= Asc("芭") And Asc(t1) < Asc("擦") Then
GetPY = "B"
Exit Function
End If
If Asc(t1) >= Asc("擦") And Asc(t1) < Asc("搭") Then
GetPY = "C"
Exit Function
End If
If Asc(t1) >= Asc("搭") And Asc(t1) < Asc("蛾") Then
GetPY = "D"
Exit Function
End If
If Asc(t1) >= Asc("蛾") And Asc(t1) < Asc("发") Then
GetPY = "E"
Exit Function
End If
If Asc(t1) >= Asc("发") And Asc(t1) < Asc("噶") Then
GetPY = "F"
Exit Function
End If
If Asc(t1) >= Asc("噶") And Asc(t1) < Asc("哈") Then
GetPY = "G"
Exit Function
End If
If Asc(t1) >= Asc("哈") And Asc(t1) < Asc("击") Then
GetPY = "H"
Exit Function
End If
If Asc(t1) >= Asc("击") And Asc(t1) < Asc("喀") Then
GetPY = "J"
Exit Function
End If
If Asc(t1) >= Asc("喀") And Asc(t1) < Asc("垃") Then
GetPY = "K"
Exit Function
End If
If Asc(t1) >= Asc("垃") And Asc(t1) < Asc("妈") Then
GetPY = "L"
Exit Function
End If
If Asc(t1) >= Asc("妈") And Asc(t1) < Asc("拿") Then
GetPY = "M"
Exit Function
End If
If Asc(t1) >= Asc("拿") And Asc(t1) < Asc("哦") Then
GetPY = "N"
Exit Function
End If
If Asc(t1) >= Asc("哦") And Asc(t1) < Asc("啪") Then
GetPY = "O"
Exit Function
End If
If Asc(t1) >= Asc("啪") And Asc(t1) < Asc("期") Then
GetPY = ""
Exit Function
End If
If Asc(t1) >= Asc("期") And Asc(t1) < Asc("然") Then
GetPY = "Q"
Exit Function
End If
If Asc(t1) >= Asc("然") And Asc(t1) < Asc("撒") Then
GetPY = "R"
Exit Function
End If
If Asc(t1) >= Asc("撒") And Asc(t1) < Asc("塌") Then
GetPY = "S"
Exit Function
End If
If Asc(t1) >= Asc("塌") And Asc(t1) < Asc("挖") Then
GetPY = "T"
Exit Function
End If
If Asc(t1) >= Asc("挖") And Asc(t1) < Asc("昔") Then
GetPY = "W"
Exit Function
End If
If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("压") Then
GetPY = "X"
Exit Function
End If
If Asc(t1) >= Asc("压") And Asc(t1) < Asc("匝") Then
GetPY = "Y"
Exit Function
End If
If Asc(t1) >= Asc("匝") Then
GetPY = "Z"
Exit Function
End If
Else
If UCase(a1) <= "Z" And UCase(a1) >= "A" Then
GetPY = UCase(Left(a1, 1))
Else
GetPY = "0"
End If
End If
End Function

竹笛

嘻嘻~~~~~~~，我也抄一个，从WTM1那里抄来的，这是获取第一个声母：
Public Function PinYin(Tstr As String) As String
  Dim i As Long, p As Integer
  i = Asc(Tstr)
  If i >= Asc("啊") And i < Asc("芭") Then p = 65
  If i >= Asc("芭") And i < Asc("擦") Then p = 66
  If i >= Asc("擦") And i < Asc("搭") Then p = 67
  If i >= Asc("搭") And i < Asc("蛾") Then p = 68
  If i >= Asc("蛾") And i < Asc("发") Then p = 69
  If i >= Asc("发") And i < Asc("噶") Then p = 70
  If i >= Asc("噶") And i < Asc("哈") Then p = 71
  If i >= Asc("哈") And i < Asc("击") Then p = 72
  If i >= Asc("击") And i < Asc("喀") Then p = 74
  If i >= Asc("喀") And i < Asc("垃") Then p = 75
  If i >= Asc("垃") And i < Asc("妈") Then p = 76
  If i >= Asc("妈") And i < Asc("拿") Then p = 77
  If i >= Asc("拿") And i < Asc("哦") Then p = 78
  If i >= Asc("哦") And i < Asc("啪") Then p = 79
  If i >= Asc("啪") And i < Asc("欺") Then p = 80
  If i >= Asc("欺") And i < Asc("然") Then p = 81
  If i >= Asc("然") And i < Asc("撒") Then p = 82
  If i >= Asc("撒") And i < Asc("塌") Then p = 83
  If i >= Asc("塌") And i < Asc("挖") Then p = 84
  If i >= Asc("挖") And i < Asc("昔") Then p = 87
  If i >= Asc("昔") And i < Asc("压") Then p = 88
  If i >= Asc("压") And i < Asc("匝") Then p = 89
  If i >= Asc("匝") And i <= Asc("座") Then p = 90
  PinYin = Chr(p)
End Function

竹笛

例子在此！文件下载

huanghai

NORTHNWIND的，哈哈

jiangyi

蒙人呢!

cogolv

谢谢分享

fan0217

以下是引用jiangyi在2003-2-6 12:27:00的发言：
蒙人呢!

不是蒙人，是你没有注意去看系统提供的例子。