Function trans(number As String) As String
  Dim x As String, y As String
  x = Split(number, ".")(0)
  Const upcase = "○一二三四五六七八九 十百千万十百千万亿十百千万十百千万"         '定义汉字
  If Val(x) >= 10 ^ 16 Then MsgBox "数目太大，无法换算！请输入一亿亿以下的数字！", 64, "错误提示": Exit Function '只能转换一亿亿以下的数字！
  If InStr(number, ".") > 0 Then
  y = Split(number, ".")(1)
  For i = 0 To 9
  y = Replace(y, i, Mid(upcase, i + 1, 1))
  Next
  y = "点" & y
  End If
  For i = 1 To Len(x)
  trans = trans & Mid(upcase, Mid(x, i, 1) + 1, 1) & Mid(upcase, Len(x) - i + 11, 1)
  Next
  trans = Replace(trans, "○千", "○")
  trans = Replace(trans, "○百", "○")
  trans = Replace(trans, "○十", "○")
   
  Do While InStr(trans, "○○") > 0
  trans = Replace(trans, "○○", "○")
  Loop
  trans = Replace(trans, "○亿", "亿")
  trans = Replace(trans, "○万", "万")
If Val(x) < 20 Then trans = Replace(trans, "一十", "十")
trans = Trim(trans) & y
  End Function
   
 Private Sub Command1_Click()
   MsgBox trans("67454801211.783450980896")
  End Sub

 

本文来源：http://blog.csdn.net/northwolves/archive/2007/06/25/1665151.aspx