当前位置:文档之家› 汉字取拼音首字母程序vba

汉字取拼音首字母程序vba

Option Explicit
Public Sub dnxbz()
Dim myrange As Range
Dim i As Long, j As Long
Dim temp As String
Set myrange = Worksheets("Sheet1").Range("a1").CurrentRegion
For i = 1 To myrange.Rows.Count '从1行开始到有数据的最后一行
temp = Cells(i, "A") '假设原数据在A列
For j = 1 To Len(temp)
If Get_Pinyin(Mid(temp, j, 1)) <> "" Then Mid(temp, j, 1) = Get_Pinyin(Mid(temp, j, 1)) '如果速度慢再加个变量
Next
Cells(i, "B") = temp '假设B列为输出数据
Next
End Sub
Public Function Get_Pinyin(ByVal Hanzi As String) As String
Dim Ch As String
Ch = Left(Hanzi, 1)
Select Case Asc(Ch)
Case -20319 To -20284
Get_Pinyin = "A"
Case -20283 To -19776
Get_Pinyin = "B"
Case -19775 To -19219
Get_Pinyin = "C"
Case -19218 To -18711
Get_Pinyin = "D"
Case -18710 To -18527
Get_Pinyin = "E"
Case -18526 To -18240
Get_Pinyin = "F"
Case -18239 To -17923
Get_Pinyin = "G"
Case -17922 To -17418
Get_Pinyin = "H"
Case -17417 To -16475
Get_Pinyin = "J"
Case -16474 To -16217
Get_Pinyin = "K"
Case -16216 To -15641 Get_Pinyin = "L" Case -15640 To -15166 Get_Pinyin = "M" Case -15165 To -14923 Get_Pinyin = "N" Case -14922 To -14915 Get_Pinyin = "O" Case -14914 To -14631 Get_Pinyin = "P" Case -14630 To -14150 Get_Pinyin = "Q" Case -14149 To -14091 Get_Pinyin = "R" Case -14090 To -13319 Get_Pinyin = "S" Case -13318 To -12839 Get_Pinyin = "T" Case -12838 To -12557 Get_Pinyin = "W" Case -12557 To -11848 Get_Pinyin = "X" Case -11847 To -11056 Get_Pinyin = "Y" Case -11055 To -10246 Get_Pinyin = "Z" Case Else
Get_Pinyin = ""
End Select
End Function。

相关主题