Db = Split(PYDB(0), ,) ReDim PY_Index(UBound(Db)) For i = 1 To UBound(Db) PY_Index(i) = Db(i - 1) Next i For i = 1 To 72 Db = Split(PYDB(i), ,) For j = 1 To UBound(Db) PY_DB(i, j) = Db(j - 1) Next j N
Db = Split(PYDB(0), ",")
ReDim PY_Index(UBound(Db))
For i = 1 To UBound(Db)
PY_Index(i) = Db(i - 1)
Next i
For i = 1 To 72
Db = Split(PYDB(i), ",")
For j = 1 To UBound(Db)
PY_DB(i, j) = Db(j - 1)
Next j
Next i
End Sub
Public Function PinYin(TXT As Variant, Delimiter As String, Tpy As Byte) As String
Dim N As Integer
Dim ASCID As Long
Dim Y As Byte
Dim M_Txt As String
Dim M_PY As String
Dim MI_PY As String
Application.Volatile
On Error Resume Next
If PY_DB(72, 94) <> "ā/á/ǎ/à" And Tpy = 5 Then
Call DealVal_2
ElseIf PY_DB(72, 94) <> "a1" And Tpy < 5 Then
Call DealVal_1
End If
If TXT = "" Then
PinYin = ""
Exit Function
End If
For i = 1 To Len(Trim(TXT))
M_Txt = Mid(Trim(TXT), i, 1)
If M_Txt = "" Then
MI_PY = ""
Else
ASCID = Asc(M_Txt)
For N = 1 To UBound(PY_Index)
If PY_Index(N) < ASCID Then
Exit For
End If
Next N
PYDB_Index = PY_Index(N - 1) - ASCID
If PYDB_Index < 0 Or PYDB_Index > 93 Then
M_PY = M_Txt
Y = 1
Else
M_PY = PY_DB(N - 1, PYDB_Index + 1)
End If
End If
Select Case Tpy
Case 1
MI_PY = M_PY
Case 2
MI_PY = IIf(M_PY = M_Txt, M_PY, Mid(M_PY, 1, Len(M_PY) - 1))
Case 3
MI_PY = Left(M_PY, 1)
Case 4
MI_PY = UCase(Left(M_PY, 1))
Case 5
MI_PY = M_PY
End Select
PinYin = PinYin & IIf(M_PY = M_Txt, MI_PY, IIf(Y = 1, Delimiter & MI_PY & Delimiter, IIf(i = Len(Trim(TXT)), MI_PY, MI_PY & Delimiter)))
Y = IIf(Y = 1, IIf(M_PY = M_Txt, 1, 0), 0)
Next i
End Function
Public Function PY(TXT As Variant, Delimiter As String) As String
Application.Volatile
For Each p In Split(TXT, Delimiter)
PY = PY & UCase(Left(p, 1))
Next
End Function
本帖参考内容：
http://club.excelhome.net/forum.php?mod=viewthread&tid=736514&page=1#pid4999766
