汉字取拼音首字母程序vba
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
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