汉字转拼音首字母，自定义函数，多方案对比

lipton

谢谢分享,支持一下.

YZC51

'自定义函数：汉字转为拼音首字母（最优方案之一），代码精简，不考虑多音字几乎全部准确（只差一个“咗”字）
'原理：穷举所有汉字，然后在单元格中按拼音排序，从而确定首字母区间
'注意：本函数须配合声明中的“Option Compare Text”使用
Function Pyy$(ByVal rng$)
    Dim i%, k%, str$, ch$
    str = Replace(Replace(rng, " ", ""), "　", "")          '去空格和Tab
    For i = 1 To Len(str)
        k = 1
        ch = Mid(str, i, 1)
        If ch Like "[一-龥]" Then       '如果是汉字，进行转换
            Do Until Mid("八攃咑妸发旮哈丌丌咔垃妈乸噢帊七冄仨他屲屲屲夕丫帀咗", k, 1) > ch
                k = k + 1
                If ch = "咗" Then k = 26: Exit Do
            Loop
            Pyy = Pyy & Chr(64 + k)
        Else
            'Pyy = Pyy & UCase(ch)       '如果不是汉字，直接输出
        End If
    Next
End Function

解决"咗" 的问题

ggmmlol

挑个骨头：方案4的第八行：
Py = Py & WorksheetFunction.Lookup(Mid(str, i, 1), pyArr)
改为
Py = Py & WorksheetFunction.Lookup(ch, pyArr)

zhangcheng6688

vitrel 发表于 2018-6-30 14:49
方案四（推荐使用）：
或：

mark,谢谢楼主的热心分享。

fxl447098457

我就用用网抓或者词库。看到一个js的词库做的还行。http://blog.haoji.me/pinyinjs.html?from=xa,多音字也有部分准确的。以后分词工具配合大量的词库分析的话，多音字的方案也会越来越好了。。

vitrel

fxl447098457 发表于 2018-7-1 10:12
我就用用网抓或者词库。看到一个js的词库做的还行。http://blog.haoji.me/pinyinjs.html?from=xa,多音字也 ...

FanXiaoLei老师，您好！
您所提供的网页，里面的内容确实很值得学习。
无奈我水平有限，暂时还未打通VBA与JS之间的通道，
但我想，留起来将来还是有相当的研究价值的。
在此，先谢过了！

fxl447098457

vitrel 发表于 2018-7-1 15:23
FanXiaoLei老师，您好！
您所提供的网页，里面的内容确实很值得学习。
无奈我水平有限，暂时还未打通VB ...

python有一个pypinyin包,我写过一个帖子，拿到VBA里用用也还行。你可以看看。

一把小刀闯天下

vitrel 发表于 2018-6-30 14:49
方案四（推荐使用）：
或：

'试了一下很不错，感谢分享

'稍作修改，自用

Option Explicit

Sub test()
  Dim s
  s = "各位大神好h,323!2$%^hh，啊d做"
  MsgBox s & vbNewLine & py(s)
End Sub

Function py(s) As String
  Dim mark, i, j
  mark = "吖八攃咑妸发旮哈咗丌咔垃妈乸噢帊七冄仨他咗咗屲夕丫帀咗"
'  s = Trim(Replace(Replace(s, Space(1), vbNullString), vbTab, vbNullString))
'  If Len(s) = 0 Then Exit Function
  For i = 1 To Len(s)
    If Mid(s, i, 1) Like "[一-龥]" Then
      For j = Len(mark) To 1 Step -1
        If StrComp(Mid(s, i, 1), Mid(mark, j, 1), vbTextCompare) = 1 Then _
          py = py & Chr(64 + j): Exit For
      Next
    Else
      py = py & Mid(s, i, 1)
    End If
  Next
End Function

vitrel

一把小刀闯天下 发表于 2018-7-1 18:39
'试了一下很不错，感谢分享

'稍作修改，自用

您好您好！
挑一下您的骨头，您勿介意。
您重写的代码，对于“吖”字，出不了“A”哦！就这一个字。

vitrel

fxl447098457 发表于 2018-7-1 18:33
python有一个pypinyin包,我写过一个帖子，拿到VBA里用用也还行。你可以看看。

好的好的，我去您的得分主题去学习学习一下，
谢谢您！