EXCEL能否实现自动读取汉字的首字拼音字母??要用VBA吗??

tfyytl

如题,假如有以下表

简写    姓名 ...

ZS      张三

LS     李四

现在这个表有几千行,能否在EXCEL里自动识别"简写"列里的拼音首字,而不用手工输入!

[此贴子已经被作者于2007-11-7 10:58:02编辑过]

张三李四

备一张汉字拼音对照表。用VBA自动查找对照表中的汉字，再查出对应的首字母。

tfyytl

能否具体点啊

maditate

 

waz1xZcQ.rar (242.05 KB, 下载次数: 576)

2007-11-7 11:52 上传

点击文件名下载附件
也许有用

[此贴子已经被作者于2007-11-7 11:52:08编辑过]

tfyytl

十分感谢,如果有这张汉字拼音对照表,那么用VLOOKUP函数也可以实现码!

张三李四

QUOTE:

以下是引用tfyytl在2007-11-7 13:09:44的发言：
十分感谢,如果有这张汉字拼音对照表,那么用VLOOKUP函数也可以实现码!

我想有了底版用什么办法已经不重要了。

lj1226189

Function GetHzjp(strHz As String) As String

Dim num As Long
Dim i As Long

GetHzjp = ""
For i = 1 To Len(strHz)
    num = Asc(Mid(LCase(strHz), i, 1))
    If num > 0 And num <= 127 Then GetHzjp = GetHzjp + Chr(num)
   
    If num >= -23647 And num <= -23554 Then GetHzjp = GetHzjp + Chr(num + 23680)
   
    If num >= &HB0A1 And num <= &HB0C4 Then GetHzjp = GetHzjp + "a"
    If num >= &HB0C5 And num <= &HB2C0 Then GetHzjp = GetHzjp + "b"
    If num >= &HB2C1 And num <= &HB4ED Then GetHzjp = GetHzjp + "c"
    If num >= &HB4EE And num <= &HB6E9 Then GetHzjp = GetHzjp + "d"
    If num >= &HB6EA And num <= &HB7A1 Then GetHzjp = GetHzjp + "e"
    If num >= &HB7A2 And num <= &HB8C0 Then GetHzjp = GetHzjp + "f"
    If num >= &HB8C1 And num <= &HB9FD Then GetHzjp = GetHzjp + "g"
    If num >= &HB9FE And num <= &HBBF6 Then GetHzjp = GetHzjp + "h"
    If num >= &HBBF7 And num <= &HBFA5 Then GetHzjp = GetHzjp + "j"

    If num >= &HBFA6 And num <= &HC0AB Then GetHzjp = GetHzjp + "k"
    If num >= &HC0AC And num <= &HC2E7 Then GetHzjp = GetHzjp + "l"
    If num >= &HC2E8 And num <= &HC4C2 Then GetHzjp = GetHzjp + "m"

    If num >= &HC4C3 And num <= &HC5B5 Then GetHzjp = GetHzjp + "n"
    If num >= &HC5B6 And num <= &HC5BD Then GetHzjp = GetHzjp + "o"
    If num >= &HC5BE And num <= &HC6D9 Then GetHzjp = GetHzjp + "p"
    If num >= &HC6DA And num <= &HC8BA Then GetHzjp = GetHzjp + "q"
    If num >= &HC8BB And num <= &HC8F5 Then GetHzjp = GetHzjp + "r"
    If num >= &HC8F6 And num <= &HCBF9 Then GetHzjp = GetHzjp + "s"
    If num >= &HCBFA And num <= &HCDD9 Then GetHzjp = GetHzjp + "t"
    If num >= &HCDDA And num <= &HCEF3 Then GetHzjp = GetHzjp + "w"
    If num >= &HCEF4 And num <= &HD188 Then GetHzjp = GetHzjp + "x"
    If num >= &HD1B9 And num <= &HD4D0 Then GetHzjp = GetHzjp + "y"
    If num >= &HD4D1 And num <= &HF7F9 Then GetHzjp = GetHzjp + "z"
Next

GetHzjp = LCase(GetHzjp)

End Function

northwolves

可简化为:

Function pinyin(ByVal r As Range) As String
Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝ABCDEFGHJKLMNOPQRSTWXYZZ"
Dim i As Long, j As Byte, temp As String
For i = 1 To Len(r.Text)
For j = 1 To 24
If Asc(Mid(r.Text, i, 1)) >= Asc(Mid(hanzi, j, 1)) Then temp = Mid(hanzi, 23 + j, 1)
Next
pinyin = pinyin & temp
Next
End Function 

用法：b1输入公式 =pinyin(a1)

参考: http://blog.csdn.net/northwolves/archive/2007/05/24/1624766.aspx

maditate

狼版的方法只适用于常用字，大量非常用字不准确。

[此贴子已经被作者于2007-11-8 12:20:35编辑过]

lj1226189

Function lj(n As Range)
Dim d As Object, x&, i&, arr(), k As Long
Set d = CreateObject("scripting.dictionary")
k = Sheet1.[a55555].End(xlUp).Row
arr = Sheet1.Range("a1:b" & k)
For i = 1 To k
        d(arr(i, 1)) = i
Next i
x = Len(n)
If x = 0 Then
lj = ""
Else
For k = 1 To x
s = d(Mid(n, k, 1))
If s <> "" Then
lj = lj & arr(s, 2)
End If
Next
End If
End Function