这个函数不错。
最初我在accessqq上,也是原来楼主的的网站,看到一个函数,用了很长时间,后来发现不能认识“胡埭”(一个地名)的“埭”字。函数如下
Public Function HZ2PY(Tstr As String, Optional onlyFirst As Boolean) As String
On Error GoTo err
If onlyFirst Then Tstr = Left(Tstr, 1)
Dim intTstrLong As Integer
Dim strPY As String
Dim i As Long, p As Integer
For intTstrLong = 1 To Len(Tstr)
i = Asc(Mid(Tstr, intTstrLong, 1))
If i <= Asc("啊") Or i >= Asc("座") Then
strPY = strPY & Mid(Tstr, intTstrLong, 1)
Else
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
strPY = strPY & Chr(p)
End If
Next intTstrLong
HZ2PY = strPY
Exit Function
err:
MsgBox err.Number & err.Description
End Function
再后来,看了trynew的一个作品,解决了“埭”字,但发现“金属”的“属”字,因为是多音字的原因,函数认为金属是jz,我要的是js。
再后来,看到f0217(好像是)提供了一个既可以查拼音又可以查笔画的函数,但发现“金属”的“属”字,还是不能正确识别,返回值还是jz。
今天看了这个函数,试试后,发现,OK。
但是,这个函数要配合“字库表”才行,这样就要在数据库中一直保存好这个表,表名也要保持一致,不能误删除。这个函数的缺点是,不是纯函数,很难在其他地方用,比如Excel中等。前两个函数是纯代码的函数。
从运行效率上比较(我的比较结果),纯函数要快很多很多。
未完
[此贴子已经被作者于2006-3-24 9:07:10编辑过]
|