关于excel姓名批量提取的的问题!!!
发布网友
发布时间：2022-04-26 19:52
共3个回答
热心网友
时间：2022-07-12 06:38
syht2000 的方法有效，但也有点瑕次。
例如：中华人民共和国 结果是：ZMRMMMM
例如：姚12明 结果是：Y12M
疏影横斜01 的方法更方便更快，且不用宏。3个字以上的汉字只要把公式不断增加即可
例如：中华人民共和国 公式：=VLOOKUP(MID(A2,1,1),PinYin,2)&VLOOKUP(MID(A2,2,1),PinYin,2)&VLOOKUP(MID(A2,3,1),PinYin,2)&VLOOKUP(MID(A2,4,1),PinYin,2)&VLOOKUP(MID(A2,5,1),PinYin,2)&VLOOKUP(MID(A2,6,1),PinYin,2)&VLOOKUP(MID(A2,7,1),PinYin,2)
例如：姚12明 结果是：YM
因此，我认为疏影横斜01的结果正确。
以下是我用以上两位改版syht2000的*：
第一种：无论汉字、数字、字母、符号都显示，例如：<>姚12明MM 结果：<>Y12MMM
Public Function SuperPY(ByVal vText As Variant) As String
Application.Volatile
Dim strResult As String
Dim lStart As Long
Dim sTemp As String
On Error Resume Next
For lStart = 1 To Len(vText)
sTemp = VBA.StrConv(Mid(vText, lStart, 1), vbNarrow)
If Len(sTemp) <> LenB(StrConv(sTemp, vbFromUnicode)) Then '是否为汉字
strResult = strResult & Application.Evaluate("VLookup(""" & Mid(vText, _
lStart, 1) & _
""",{""吖"",""A"";""八"",""B"";""嚓"",""C"";""哒"",""D"";""屙"",""E"";""发"",""F"";""旮"",""G"";""铪"",""H"";""丌"",""J"";""咔"",""K"";""垃"",""L"";""妈"",""M"";""拿"",""N"";""噢"",""O"";""趴"",""P"";""七"",""Q"";""蚺"",""R"";""仨"",""S"";""他"",""T"";""哇"",""W"";""夕"",""X"";""丫"",""Y"";""匝"",""Z""},2,1)")
Else
strResult = strResult & Mid(vText, lStart, 1)
End If
Next
SuperPY = strResult
End Function
第二种：非汉字被滤掉，仅对汉字显示。例如：<>姚12明MM 结果：YM
Public Function SuperPYHZ(ByVal vText As Variant) As String
Application.Volatile
Dim strResult As String
Dim lStart As Long
Dim sTemp As String
On Error Resume Next
For lStart = 1 To Len(vText)
sTemp = VBA.StrConv(Mid(vText, lStart, 1), vbNarrow)
If Len(sTemp) <> LenB(StrConv(sTemp, vbFromUnicode)) Then '是否为汉字
strResult = strResult & Application.Evaluate("VLookup(""" & Mid(vText, _
lStart, 1) & _
""",{""吖"",""A"";""八"",""B"";""嚓"",""C"";""哒"",""D"";""屙"",""E"";""发"",""F"";""旮"",""G"";""铪"",""H"";""丌"",""J"";""咔"",""K"";""垃"",""L"";""妈"",""M"";""拿"",""N"";""噢"",""O"";""趴"",""P"";""七"",""Q"";""蚺"",""R"";""仨"",""S"";""他"",""T"";""哇"",""W"";""夕"",""X"";""丫"",""Y"";""匝"",""Z""},2,1)")
End If
Next
SuperPYHZ = strResult
End Function
热心网友
时间：2022-07-12 06:39
这个要用VBA，比如说你的姓名在A列，A1开始，那先按Alt+F11进VBA，在thisworkbook上右键插入模块，贴上以下代码
Public Function SuperPY(ByVal vText As Variant) As String
Application.Volatile
Dim strResult As String
Dim lStart As Long
Dim sTemp As String
On Error Resume Next
For lStart = 1 To Len(vText)
sTemp = VBA.StrConv(Mid(vText, lStart, 1), vbNarrow)
If Len(sTemp) <> LenB(StrConv(sTemp, vbFromUnicode)) Then '是否为汉字
strResult = strResult & Application.Evaluate("VLookup(""" & Mid(vText, _
lStart, 1) & _
""",{""吖"",""A"";""八"",""B"";""嚓"",""C"";""咑"",""D"";""鵽"",""E"";""发"",""F"";""猤"",""G"";""铪"",""H"";""夻"",""J"";""咔"",""K"";""垃"",""L"";""呒"",""M"";""旀"",""N"";""噢"",""O"";""妑"",""P"";""七"",""Q"";""囕"",""R"";""仨"",""S"";""他"",""T"";""屲"",""W"";""夕"",""X"";""丫"",""Y"";""帀"",""Z""},2,1)")
Else
strResult = strResult & Mid(vText, lStart, 1)
End If
Next
SuperPY = strResult
End Function
然后关掉VBA，在B1输入=superpy(A1)
双击B1的右下填充钮向下填充就行了（当然你向下拖动也行）
热心网友
时间：2022-07-12 06:39
1. 在公式>定义名称中,创建名称 "PinYin", 引用位置内容为: ={"","";"吖","A";"八","B";"嚓","C";"哒","D";"屙","E";"发","F";"旮","G";"铪","H";"丌","J";"咔","K";"垃","L";"妈","M";"拿","N";"噢","O";"趴","P";"七","Q";"蚺","R";"仨","S";"他","T";"哇","W";"夕","X";"丫","Y";"匝","Z"}
2. 在简称单元格内输入公式: =VLOOKUP(MID(A1,1,1),PinYin,2)&VLOOKUP(MID(A1,2,1),PinYin,2)&VLOOKUP(MID(A1,3,1),PinYin,2)
公式假设姓名在A列,简称单元格开始为B1
