金额大写转小写的宏函数

zhui_

可能由于中文表示法的博大精深，论坛上解决金额大写转小写的方法与小写转大写相比十分稀少，找到几个发现对大金额（兆以上）无法转换
由于工作需要，参考众家所长写了以下宏函数，欢迎测试，同时还有一个问题未解决： 单写元,万,亿,兆,转换为0，不能直接转换为1，10000等，望集大家智慧能完美解决
Function 金额转换(Optional ByVal InString As String = "-0.00", Optional ByVal Flag As String = "小写转大写") As String
On Error Resume Next
Err.Clear
Dim Ll1 As Long
Dim Ss1 As String
Dim Ss2 As String
金额转换 = ""
If InString = "-0.00" Then
  Flag = InputBox("请输入处理方式:" & vbCrLf & "小写转大写" & vbCrLf & "大写转小写(支持非规范写法)", "金额转换", "小写转大写")
  InString = InputBox("请输入需转换的内容", "金额转换", "0.00")
  Ss2 = "1"
End If
Select Case Flag
  Case "小写转大写"
   Ss1 = Replace(Application.Text(Round(CCur(InString) + 0.00001, 2), "[DBnum2]"), ".", "元")
   Ss1 = IIf(Left(Right(Ss1, 3), 1) = "元", Left(Ss1, Len(Ss1) - 1) & "角" & Right(Ss1, 1) & "分", IIf(Left(Right(Ss1, 2), 1) = "元", Ss1 & "角整", IIf(Ss1 = "零", "", Ss1 & "元整")))
   Ss1 = Replace(Replace(Replace(Replace(Ss1, "零元零角", ""), "零元", ""), "零角", "零"), "-", "负")
   If Ss1 = "" Then Ss1 = "零元整"
   If Er Then Ss1 = "Error"
  Case "大写转小写" '单写元,万,亿,兆,转换为0
   InString = Replace(Replace(InString, "零", "0"), "○", "0")
   InString = Replace(Replace(InString, "壹", "1"), "一", "1")
   InString = Replace(Replace(Replace(InString, "贰", "2"), "二", "2"), "弍", "2")
   InString = Replace(Replace(InString, "叁", "3"), "三", "3")
   InString = Replace(Replace(InString, "肆", "4"), "四", "4")
   InString = Replace(Replace(InString, "伍", "5"), "五", "5")
   InString = Replace(Replace(InString, "陆", "6"), "六", "6")
   InString = Replace(Replace(InString, "柒", "7"), "七", "7")
   InString = Replace(Replace(InString, "捌", "8"), "八", "8")
   InString = Replace(Replace(InString, "玖", "9"), "九", "9")
   InString = Replace(Replace(Replace(Replace(Replace(Replace(InString, "点", ""), "正", "整"), "整", ""), "元", "圆"), "块", "圆"), "毛", "角")
   InString = Replace(Replace(Replace(InString, "十", "拾"), "百", "佰"), "千", "仟")
   For Ll1 = 1 To Len(InString)
    Select Case Mid(InString, Ll1, 1)
     Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
      Select Case Mid(InString, Ll1 + 1, 1)
       Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
        If Mid(InString, Ll1, 1) = "0" Then
         InString = Left(InString, Ll1 - 1) & Right(InString, Len(InString) - Ll1)
         Ll1 = Ll1 - 1
        Else
         Ss1 = "Error"
         GoTo E1:
        End If
      End Select
    End Select
   Next
   If Mid(InString, Len(InString), 1) <> "分" Then InString = InString & "0分"
   If Mid(InString, Len(InString) - 2, 1) <> "角" Then InString = Left(InString, Len(InString) - 2) & "0角" & Right(InString, 2)
   If Mid(InString, Len(InString) - 4, 1) <> "圆" Then InString = Left(InString, Len(InString) - 4) & "0圆" & Right(InString, 4)
   If InStr("012356789", Mid(InString, Len(InString) - 5, 1)) = 0 Then InString = Left(InString, Len(InString) - 5) & "0圆" & Right(InString, 4)
   If Mid(InString, Len(InString) - 6, 1) <> "拾" Then InString = Left(InString, Len(InString) - 6) & "0拾" & Right(InString, 6)
   If InStr("012356789", Mid(InString, Len(InString) - 7, 1)) = 0 Then InString = Left(InString, Len(InString) - 7) & "1拾" & Right(InString, 6)
   If Mid(InString, Len(InString) - 8, 1) <> "佰" Then InString = Left(InString, Len(InString) - 8) & "0佰" & Right(InString, 8)
   If InStr("012356789", Mid(InString, Len(InString) - 9, 1)) = 0 Then InString = Left(InString, Len(InString) - 9) & "1佰" & Right(InString, 8)
   If Mid(InString, Len(InString) - 10, 1) <> "仟" Then InString = Left(InString, Len(InString) - 10) & "0仟" & Right(InString, 10)
   If InStr("012356789", Mid(InString, Len(InString) - 11, 1)) = 0 Then InString = Left(InString, Len(InString) - 11) & "1仟" & Right(InString, 10)
   If Mid(InString, Len(InString) - 12, 1) <> "万" Then InString = Left(InString, Len(InString) - 12) & "0万" & Right(InString, 12)
   If InStr("012356789", Mid(InString, Len(InString) - 13, 1)) = 0 Then InString = Left(InString, Len(InString) - 13) & "0万" & Right(InString, 12)
   If Mid(InString, Len(InString) - 14, 1) <> "拾" Then InString = Left(InString, Len(InString) - 14) & "0拾" & Right(InString, 14)
   If InStr("012356789", Mid(InString, Len(InString) - 15, 1)) = 0 Then InString = Left(InString, Len(InString) - 15) & "1拾" & Right(InString, 14)
   If Mid(InString, Len(InString) - 16, 1) <> "佰" Then InString = Left(InString, Len(InString) - 16) & "0佰" & Right(InString, 16)
   If InStr("012356789", Mid(InString, Len(InString) - 17, 1)) = 0 Then InString = Left(InString, Len(InString) - 17) & "1佰" & Right(InString, 16)
   If Mid(InString, Len(InString) - 18, 1) <> "仟" Then InString = Left(InString, Len(InString) - 18) & "0仟" & Right(InString, 18)
   If InStr("012356789", Mid(InString, Len(InString) - 19, 1)) = 0 Then InString = Left(InString, Len(InString) - 19) & "1仟" & Right(InString, 18)
   If Mid(InString, Len(InString) - 20, 1) <> "亿" Then InString = Left(InString, Len(InString) - 20) & "0亿" & Right(InString, 20)
   If InStr("012356789", Mid(InString, Len(InString) - 21, 1)) = 0 Then InString = Left(InString, Len(InString) - 21) & "0亿" & Right(InString, 20)
   If Mid(InString, Len(InString) - 22, 1) <> "拾" Then InString = Left(InString, Len(InString) - 22) & "0拾" & Right(InString, 22)
   If InStr("012356789", Mid(InString, Len(InString) - 23, 1)) = 0 Then InString = Left(InString, Len(InString) - 23) & "1拾" & Right(InString, 22)
   If Mid(InString, Len(InString) - 24, 1) <> "佰" Then InString = Left(InString, Len(InString) - 24) & "0佰" & Right(InString, 24)
   If InStr("012356789", Mid(InString, Len(InString) - 25, 1)) = 0 Then InString = Left(InString, Len(InString) - 25) & "1佰" & Right(InString, 24)
   If Mid(InString, Len(InString) - 26, 1) <> "仟" Then InString = Left(InString, Len(InString) - 26) & "0仟" & Right(InString, 26)
   If InStr("012356789", Mid(InString, Len(InString) - 27, 1)) = 0 Then InString = Left(InString, Len(InString) - 27) & "1仟" & Right(InString, 26)
   If Mid(InString, Len(InString) - 28, 1) <> "兆" Then InString = Left(InString, Len(InString) - 28) & "0兆" & Right(InString, 28)
   If InStr("012356789", Mid(InString, Len(InString) - 29, 1)) = 0 Then InString = Left(InString, Len(InString) - 29) & "0兆" & Right(InString, 28)
   If Mid(InString, Len(InString) - 30, 1) <> "拾" Then InString = Left(InString, Len(InString) - 30) & "0拾" & Right(InString, 30)
   If InStr("012356789", Mid(InString, Len(InString) - 31, 1)) = 0 Then InString = Left(InString, Len(InString) - 31) & "1拾" & Right(InString, 30)
   If Mid(InString, Len(InString) - 32, 1) <> "佰" Then InString = Left(InString, Len(InString) - 32) & "0佰" & Right(InString, 32)
   If InStr("012356789", Mid(InString, Len(InString) - 33, 1)) = 0 Then InString = Left(InString, Len(InString) - 33) & "1佰" & Right(InString, 32)
   If Len(Replace(InString, "负", "")) <> 34 Then
    Ss1 = "Error"
    GoTo E1:
   End If
   For Ll1 = 1 To Len(InString)
    Select Case Mid(InString, Ll1, 1)
     Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "负"
      Ss1 = Ss1 & Mid(InString, Ll1, 1)
     Case Else
    End Select
   Next
   Ss1 = Replace(Left(Ss1, Len(Ss1) - 2) & "." & Right(Ss1, 2), "负", "-")
   Ss1 = CStr(CCur(Ss1))
   If Ss1 = "" Then Ss1 = "Error"
End Select
E1:
If Ss2 = "1" Then MsgBox Ss1
金额转换 = Ss1
End Function

wshcw

LDY版主有精简代码：
Function DxToN(ss)
For i% = 1 To 9
ss = Replace(ss, Mid("壹贰叁肆伍陆柒捌玖", i, 1), i)
ss = Replace(ss, Mid("一二三四五六七八九", i, 1), i)
Next
For i% = Len(ss) To 1 Step -1
s$ = Mid$(ss, i, 1)
X% = InStr("分角圆拾佰仟万拾佰仟亿拾佰仟兆", s)
If X = 0 Then X% = InStr("分毛元十百千万十百千亿十百千兆", s)
If X = 0 Then X% = InStr("分毛块十百千万十百千亿十百千兆", s)
If X Then j% = IIf(j% < X, X, ((j - 3) \ 4) * 4 + X)
If Val(s) Then m# = m# + (s & String(j - 1, "0")) / 100
Next
DxToN = Round(m, 2)
If InStr(ss, "-") Or InStr(ss, "负") Then DxToN = -DxToN
End Functi

crystalice2008

这个代码要如何写入excel 呢

yj0715

这个太厉害了

OKJSJSF

大写转小写数字原来这么难！

jjmysjg

先留下记号。以前用的是函数

PersueOfPersist

这个不错的