Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 7714|回复: 7

[已解决]汉字自动拼音后名字和姓氏首字母大写

[复制链接]
发表于 2014-8-29 09:15 | 显示全部楼层 |阅读模式
请大神能不能优化一下本论坛的帖子
http://www.excelpx.com/thread-328118-1-1.html

我想名字和姓氏首字大写。可以吗?
例如:西门吹雪 = XimenChuixue;郭富城 = GuoFucheng;刘德华 = Liu Dehua

附件我也粘贴过来了:
最佳答案
2014-8-29 10:30
本帖最后由 zjdh 于 2014-8-29 10:34 编辑

Function PinYin(Rng As Range)
    ........................
    For j = 1 To Len(Rng.Value)
        str = Mid(Rng.Value, j, 1)
        If dic.exists(str) Then
            If j < 3 Then
                PinYin = PinYin & WorksheetFunction.Proper(dic(str))
            Else
                PinYin = PinYin & LCase(dic(str))
            End If
        Else
            PinYin = PinYin & LCase(str)
        End If
    Next
End Function

拼音全部foxpro.rar

40.73 KB, 下载次数: 78

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-8-29 09:48 | 显示全部楼层
试试看
  1. Function PinYin(Rng As Range)    Dim dic As Object, i%, j%, arr, str$, irow%
  2.     PinYin = ""
  3.     Set dic = CreateObject("scripting.dictionary")
  4.     irow = Sheets("hanziku").Cells(Rows.Count, "A").End(xlUp).Row
  5.     arr = Sheets("hanziku").Range("a1:b" & irow)
  6.     For i = 1 To UBound(arr)
  7.         For j = 1 To Len(arr(i, 1))
  8.             str = Mid(arr(i, 1), j, 1)
  9.             If Not dic.exists(str) Then
  10.                 dic(str) = arr(i, 2)
  11.             End If
  12.         Next
  13.     Next
  14.     For j = 1 To Len(Rng.Value)
  15.         str = Mid(Rng.Value, j, 1)
  16.         If dic.exists(str) Then
  17.             PinYin = PinYin & WorksheetFunction.Proper(dic(str))
  18.         Else
  19.             PinYin = PinYin & LCase(str)
  20.         End If
  21.     Next
  22. End Function
复制代码

评分

参与人数 1 +1 收起 理由
simonleung + 1 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2014-8-29 10:15 | 显示全部楼层
  1. Function PinYin(Rng As Range)
  2.     Dim j%, str$$, xRng As Range
  3.     For j = 1 To Len(Rng.Value)
  4.         str = Mid(Rng.Value, j, 1)
  5.         Set xRng = Sheets("hanziku").Range("A:A").Find(str, lookat:=xlPart)
  6.         If Not xRng Is Nothing Then
  7.             PinYin = PinYin & Application.WorksheetFunction.Proper(xRng.Offset(0, 1))
  8.         Else
  9.             PinYin = PinYin & str
  10.         End If
  11.     Next
  12. End Function
复制代码

评分

参与人数 1 +1 收起 理由
simonleung + 1 很给力!

查看全部评分

回复

使用道具 举报

发表于 2014-8-29 10:30 | 显示全部楼层    本楼为最佳答案   
本帖最后由 zjdh 于 2014-8-29 10:34 编辑

Function PinYin(Rng As Range)
    ........................
    For j = 1 To Len(Rng.Value)
        str = Mid(Rng.Value, j, 1)
        If dic.exists(str) Then
            If j < 3 Then
                PinYin = PinYin & WorksheetFunction.Proper(dic(str))
            Else
                PinYin = PinYin & LCase(dic(str))
            End If
        Else
            PinYin = PinYin & LCase(str)
        End If
    Next
End Function
回复

使用道具 举报

发表于 2014-8-29 10:31 | 显示全部楼层
grf1973 发表于 2014-8-29 10:15

多了个 $

评分

参与人数 1 +1 收起 理由
simonleung + 1 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2014-8-29 10:44 | 显示全部楼层
首位大写,方便了你的视觉,可邮箱地址中的大写,同样会给你造成麻烦的!
回复

使用道具 举报

 楼主| 发表于 2014-8-29 15:15 | 显示全部楼层
本帖最后由 simonleung 于 2014-8-29 15:18 编辑
zjdh 发表于 2014-8-29 10:30
Function PinYin(Rng As Range)
    ........................
    For j = 1 To Len(Rng.Value)

大神,复姓识别不了哦。
名字账号邮箱
张飞ZhangFeizhangfei@twsz.com
关羽GuanYuguanyu@twsz.com
诸葛亮ZhuGeliangzhugeliang@twsz.com
回复

使用道具 举报

 楼主| 发表于 2014-8-29 15:15 | 显示全部楼层
本帖最后由 simonleung 于 2014-8-29 15:18 编辑
su45 发表于 2014-8-29 10:44
首位大写,方便了你的视觉,可邮箱地址中的大写,同样会给你造成麻烦的!

账号需要首字大写,邮箱变回全小写就可以了。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 19:41 , Processed in 0.982750 second(s), 20 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表