在EXCEL表格中如何在A列输入名称，B列直接出现首字母的缩写

Question

如题所述

Answer 1

完全可以实现！

'第一步：下面是一个VBA自定义函数，按ALT＋F11，插入模块，在右面窗口中粘贴下面代码。
Function hztopy(hzpy As String) As String
  Dim hzstring As String, pystring As String
  Dim hzpysum As Integer, hzi As Integer, hzpyhex As Integer
  hzstring = Trim(hzpy)
  hzpysum = Len(Trim(hzstring))
  pystring = ""
  For hzi = 1 To hzpysum
    hzpyhex = "&H" + Hex(Asc(Mid(hzstring, hzi, 1)))
    Select Case hzpyhex
      Case &HB0A1 To &HB0C4: pystring = pystring + "A"
      Case &HB0C5 To &HB2C0: pystring = pystring + "B"
      Case &HB2C1 To &HB4ED: pystring = pystring + "C"
      Case &HB4EE To &HB6E9: pystring = pystring + "D"
      Case &HB6EA To &HB7A1: pystring = pystring + "E"
      Case &HB7A2 To &HB8C0: pystring = pystring + "F"
      Case &HB8C1 To &HB9FD: pystring = pystring + "G"
      Case &HB9FE To &HBBF6: pystring = pystring + "H"
      Case &HBBF7 To &HBFA5: pystring = pystring + "J"
      Case &HBFA6 To &HC0AB: pystring = pystring + "K"
      Case &HC0AC To &HC2E7: pystring = pystring + "L"
      Case &HC2E8 To &HC4C2: pystring = pystring + "M"
      Case &HC4C3 To &HC5B5: pystring = pystring + "N"
      Case &HC5B6 To &HC5BD: pystring = pystring + "O"
      Case &HC5BE To &HC6D9: pystring = pystring + "P"
      Case &HC6DA To &HC8BA: pystring = pystring + "Q"
      Case &HC8BB To &HC8F5: pystring = pystring + "R"
      Case &HC8F6 To &HCBF9: pystring = pystring + "S"
      Case &HCBFA To &HCDD9: pystring = pystring + "T"
      Case &HEDC5: pystring = pystring + "T"
      Case &HCDDA To &HCEF3: pystring = pystring + "W"
      Case &HCEF4 To &HD1B8: pystring = pystring + "X"
      Case &HD1B9 To &HD4D0: pystring = pystring + "Y"
      Case &HD4D1 To &HD7F9: pystring = pystring + "Z"
      Case Else
        pystring = pystring + Mid(hzstring, hzi, 1)
    End Select
  Next
  hztopy = pystring
End Function
'第二步：在代码窗口左边对应的工作表名称那里双击，粘贴下面代码进去，即可实现A列输入名字，B列显示首字母
Private Sub Worksheet_Change(ByVal Target As Range)
c = Target.Column
R = Target.Row
If R > 1 And c = 1 Then Cells(R, 2) = hztopy(Range("A" & R))
End Sub

 

追问

好复杂。看不懂

追答

请直接下载附件！
或者把你的文件发我邮箱，帮你搞定回邮给你
[email protected]

Answer 2

1.本人用Excel2003（其它版本的请仿照操作）

2.点击工具→宏→Visual Basic编辑器或者直接按“Alt+F11”组合键，进入Visual Basic编辑状态；
3.再点击“插入→模块”命令，出现一个新模块；
4.将代码输入其中；
Functionpinyin(p As String) As String
i =Asc(p)
SelectCase i
Case-20319 To -20284: pinyin = "A"
Case-20283 To -19776: pinyin = "B"
Case-19775 To -19219: pinyin = "C"
Case-19218 To -18711: pinyin = "D"
Case-18710 To -18527: pinyin = "E"
Case-18526 To -18240: pinyin = "F"
Case-18239 To -17923: pinyin = "G"
Case-17922 To -17418: pinyin = "H"
Case-17417 To -16475: pinyin = "J"
Case-16474 To -16213: pinyin = "K"
Case-16212 To -15641: pinyin = "L"
Case-15640 To -15166: pinyin = "M"
Case-15165 To -14923: pinyin = "N"
Case-14922 To -14915: pinyin = "O"
Case-14914 To -14631: pinyin = "P"
Case-14630 To -14150: pinyin = "Q"
Case-14149 To -14091: pinyin = "R"
Case-14090 To -13319: pinyin = "S"
Case-13318 To -12839: pinyin = "T"
Case-12838 To -12557: pinyin = "W"
Case-12556 To -11848: pinyin = "X"
Case-11847 To -11056: pinyin = "Y"
Case-11055 To -2050: pinyin = "Z"
CaseElse: pinyin = p
End Select
EndFunction
Functiongetpy(str)
For i= 1 To Len(str)
getpy= getpy & pinyin(Mid(str, i, 1))
Nexti
End Function
5.代码输入完成后，直接关闭Visual Basic编辑窗口，回到Excel编辑状态；
6.点击自定义函数或直接在当前表格按=就可以了，如：你的重庆在A2单元格，在放拼音的单元格输入公式：=getpy(A2)，下面的直接复制或拉动相应格式就行了。
注：个别不能识别的请手动修改。本回答被网友采纳