作者：绿色风
分类：
时间：2022-08-17
浏览：216
楼主
amulee |
Q：如何在两组姓名中找出同音不同字的姓名？
A：在许多表格中，由于人名由不同的人输入，可能造成同一个员工姓名出现不同的字。由于大多数人采用拼音输入法，因而可能造成同音不同字的姓名，却又同时表示一个人。在统一这些表格的时候就需要将这些同音不同字的姓名统一起来。
本例利用一个自定义函数，将两组姓名中同音不同字的姓名找出来，并按照第一组姓名的顺序进行排列。如图所示：
本例利用了一个拼音函数PY，该函数功能是将汉子转为拼音。本例代码如下：
- Function 同音不同字(ByVal Rng1 As Range, ByVal Rng2 As Range)
- '初始化字典
- Dim i%, j%
- InitDictinary
- Dim Arr1, Arr2, d2 As Object, TempStr$, CmpStr1$, CmpStr2$, ArrJG() As String
- Arr1 = Rng1.Value
- Arr2 = Rng2.Value
- ReDim ArrJG(1 To UBound(Arr1), 1 To 1)
- Set d2 = CreateObject("scripting.dictionary")
- '记录2的拼音
- For i = 1 To UBound(Arr2)
- If Len(Trim(Arr2(i, 1))) > 0 Then d2(PY(Arr2(i, 1))) = Arr2(i, 1)
- Next i
- '遍历1，查找拼音相同的
- For i = 1 To UBound(Arr1)
- If Len(Trim(Arr1(i, 1))) > 0 Then
- TempStr = PY(Arr1(i, 1))
- If d2.exists(TempStr) Then
- TempStr = d2(TempStr)
- CmpStr1 = ""
- CmpStr2 = ""
- '逐字判断
- For j = 1 To Len(TempStr)
- CmpStr1 = CmpStr1 & "-" & Asc(Mid(Arr1(i, 1), j, 1))
- CmpStr2 = CmpStr2 & "-" & Asc(Mid(TempStr, j, 1))
- Next j
- If CmpStr1 <> CmpStr2 Then
- ArrJG(i, 1) = TempStr
- End If
- End If
- End If
- Next i
- 同音不同字 = ArrJG
- End Function
附件参考：
 同音不同字.rar
|
2楼
eliane_lei |
进来学习,谢谢分享 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一