Excel自动提取中文首字母（代码优化版）

问题描述

今天我在创建数据库的时候遇到一个问题：数据库的字段名称是中文的，需要将中文转换成中文首字母缩写的形式，如果手动修改岂不是非常费劲，于是想用Excel的宏（VBA）来实现这个功能。

运行环境描述

• 操作系统：Windows 10
• Excel：Microsoft Office Standard 2019

实现过程

首先感谢以下分享代码的作者们！！
我在网上寻找相关的解决办法，经对比分析，应该是两个版的VBA代码：
第一个版本：wps中如何实现提取汉字的拼音首字母
第二个版本：WPS中EXCEL 获取中文首字母缩写
第三个版本：Excel中文转换为拼音（大写首字母、小写首字母、全拼、全拼首首字母大写）
首先感谢以上作者的无私分享，收获很多。
对上述版本进行分析研究，发现存在个别字体转换结果不准确的情况。
例如：

问题	转换结果
科学	K学
茉莉花	ZLH
薰衣草	ZYC
选择	选Z

解决方法

授人以鱼不如授人以渔
我想分享一下解决方法，如果再遇到类似的问题可以自行修改代码

• 1.首先我们要知道在Excel中每个中文汉字是对应一个ASCII码的
• 2.每个ASCII码对应一个字符。也就是说字符和ASCII是一 一对应的关系，如下图(部分)所示，没有转换为首字母的原因是代码内没有包含该字所对应的code代码。
  本代码根据该文章进行修改，这里不做详述，直接引用相关描述内容自行学习。
• 3.该代码中的函数内部执行的顺序有先后，前面执行了，后面便直接跳过去，继续执行后边的代码（主要利用这一点，进行修改）。
  既然知道汉字对应的ASCII码，那么再知道代码的含义不就可以修改代码。现针对上述代码中的问题，直接上修改代码。
  代码如下所示：

Function getpychar(char)
    tmp = 65536 + Asc(char)
    
    If (tmp >= 45217 And tmp <= 45252) Then
    getpychar = "A"
        
    '学、薰、  虽然与 'Z'存在范围重复，但是顺序在前，会先执行,不影响结果。
    '【注意】如果tmp数值小于45217，需要写在第一个If的前面，把第一个If 改成ElseIf，切记！
    '如果哪个字再有问题，继续添加ElseIf即可。
    ElseIf (tmp = 53671 Or tmp = 57017) Then
    getpychar = "X"
    
    '茉 字体问题
    ElseIf (tmp = 56532) Then
    getpychar = "M"
    '选
    ElseIf (tmp = 53665) Then
    getpychar = "X"
    
    
    ElseIf (tmp >= 45253 And tmp <= 45760) Then
    getpychar = "B"
    
    ElseIf (tmp >= 45761 And tmp <= 46317) Then
    getpychar = "C"
    
    ElseIf (tmp >= 46318 And tmp <= 46825) Then
    getpychar = "D"
    
    ElseIf (tmp >= 46826 And tmp <= 47009) Then
    getpychar = "E"
    
    ElseIf (tmp >= 47010 And tmp <= 47296) Then
    getpychar = "F"
    
    ElseIf (tmp >= 47297 And tmp <= 47613) Then
    getpychar = "G"
    
    ElseIf (tmp >= 47614 And tmp <= 48118) Then
    getpychar = "H"
    
    ElseIf (tmp >= 48119 And tmp <= 49061) Then
    getpychar = "J"
    
    ElseIf (tmp >= 49062 And tmp <= 49323) Then
    getpychar = "K"
    
    ElseIf (tmp >= 49324 And tmp <= 49895) Then
    getpychar = "L"
    
    ElseIf (tmp >= 49896 And tmp <= 50370) Then
    getpychar = "M"
    
    ElseIf (tmp >= 50371 And tmp <= 50613) Then
    getpychar = "N"
    
    ElseIf (tmp >= 50614 And tmp <= 50621) Then
    getpychar = "O"
    
    ElseIf (tmp >= 50622 And tmp <= 50905) Then
    getpychar = "P"
    
    ElseIf (tmp >= 50906 And tmp <= 51386) Then
    getpychar = "Q"
    
    ElseIf (tmp >= 51387 And tmp <= 51445) Then
    getpychar = "R"
    
    ElseIf (tmp >= 51446 And tmp <= 52217) Then
    getpychar = "S"
    
    ElseIf (tmp >= 52218 And tmp <= 52697) Then
    getpychar = "T"
    
    ElseIf (tmp >= 52698 And tmp <= 52979) Then
    getpychar = "W"
   
    ElseIf (tmp >= 52980 And tmp <= 53640) Then
    getpychar = "X"
    
    ElseIf (tmp >= 53679 And tmp <= 54480) Then
    getpychar = "Y"
    
    ElseIf (tmp >= 54481 And tmp <= 62289) Then
    getpychar = "Z"
    Else '如果不是中文，则不处理
    getpychar = char
    End If
End Function
'逐个取ASC码
Function getpy(str)
    For i = 1 To Len(str)
        getpy = getpy & getpychar(Mid(str, i, 1))
    Next i
End Function

• 4.接下来就是将代码加到Excel中，打开Excel,在【开发工具】内选择【Visual Basic】或者按住键盘上的 Alt+F11 组合键，调出VBA代码窗口，右键VBAProject --插入 --模块，创建模块1，将上述代码粘贴至里面保存即可。
  
  5.在Excel的单元格内输入“=getpy()”,出现下图所示情形，恭喜你已经添加成功了！
  
• 6.修改后运行结果如下所示：
  

小结

理解代码的运行逻辑就可以自行修改代码，有事儿不求人！！
如有什么特殊情形欢迎在评论区分享，优化代码！
文章分享不易，欢迎收藏点赞分享！