excel中汉字转成声母

碰到这个业务,就是需要将数据库每个客户的名字转成声母放在excel中,看了下网上,一般都用到了gb2312sm.lib文件,实则自己也可写一个函数,然后封装在库里也可.

 

Private   Function GetPY() Function GetPY(ByVal strParmeter As String) As String
          Dim intTmp     As String, i       As Long
            
          For i = 1 To Len(strParmeter)
                  intTmp = Asc(Mid(strParmeter, i, 1))
    
                  If intTmp < Asc("啊") Then
                          GetPY = GetPY & "*"
                  ElseIf intTmp >= Asc("啊") And intTmp < Asc("芭") Then
                          GetPY = GetPY & "A"
                  ElseIf intTmp >= Asc("芭") And intTmp < Asc("擦") Then
                          GetPY = GetPY & "B"
                  ElseIf intTmp >= Asc("擦") And intTmp < Asc("搭") Then
                          GetPY = GetPY & "C"
                  ElseIf intTmp >= Asc("搭") And intTmp < Asc("蛾") Then
                          GetPY = GetPY & "D"
                  ElseIf intTmp >= Asc("蛾") And intTmp < Asc("发") Then
                          GetPY = GetPY & "E"
                  ElseIf intTmp >= Asc("发") And intTmp < Asc("噶") Then
                          GetPY = GetPY & "F"
                  ElseIf intTmp >= Asc("噶") And intTmp < Asc("哈") Then
                          GetPY = GetPY & "G"
                  ElseIf intTmp >= Asc("哈") And intTmp < Asc("击") Then
                          GetPY = GetPY & "H"
                  ElseIf intTmp >= Asc("击") And intTmp < Asc("喀") Then
                          GetPY = GetPY & "J"
                  ElseIf intTmp >= Asc("喀") And intTmp < Asc("垃") Then
                          GetPY = GetPY & "K"
                  ElseIf intTmp >= Asc("垃") And intTmp < Asc("妈") Then
                          GetPY = GetPY & "L"
                  ElseIf intTmp >= Asc("妈") And intTmp < Asc("拿") Then
                          GetPY = GetPY & "M"
                  ElseIf intTmp >= Asc("拿") And intTmp < Asc("哦") Then
                          GetPY = GetPY & "N"
                  ElseIf intTmp >= Asc("哦") And intTmp < Asc("啪") Then
                          GetPY = GetPY & "O"
                  ElseIf intTmp >= Asc("啪") And intTmp < Asc("期") Then
                          GetPY = GetPY & "P"
                  ElseIf intTmp >= Asc("期") And intTmp < Asc("然") Then
                          GetPY = GetPY & "Q"
                  ElseIf intTmp >= Asc("然") And intTmp < Asc("撒") Then
                          GetPY = GetPY & "R"
                  ElseIf intTmp >= Asc("撒") And intTmp < Asc("塌") Then
                          GetPY = GetPY & "S"
                  ElseIf intTmp >= Asc("塌") And intTmp < Asc("挖") Then
                          GetPY = GetPY & "T"
                  ElseIf intTmp >= Asc("挖") And intTmp < Asc("昔") Then
                          GetPY = GetPY & "W"
                  ElseIf intTmp >= Asc("昔") And intTmp < Asc("压") Then
                          GetPY = GetPY & "X"
                  ElseIf intTmp >= Asc("压") And intTmp < Asc("匝") Then
                          GetPY = GetPY & "Y"
                  ElseIf intTmp >= Asc("匝") And intTmp < 0 Then
                          GetPY = GetPY & "Z"
                  ElseIf (intTmp >= 65 And intTmp <= 91) Or (intTmp >= 97 And intTmp <= 123) Then
                          GetPY = GetPY & Mid(strParmeter, i, 1)
                  Else
                          GetPY = GetPY & "*"
                  End If
          Next
  End Function

 先用VBA写个宏函数,然后在单元格中调用,然后利用自动填充柄填充功能来实现余下的.

比如:对B1就可以直接在单元格中写=GetPy(A1),然后双击填充柄即可.然后再导入到数据库中去.