文档库

最新最全的文档下载
当前位置:文档库 > 汉字取拼音首字母程序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"