Private Function NMoneyToSMoney(NMoney As Variant) As String
If IsNumeric(NMoney) = False Then
NMoneyToSMoney = "不是数字类型"
Exit Function
End If
Dim BasicDWString As String, BasicDW() As String
Dim MoneyDWString As String, MoneyDW() As String
Dim FormatD1String As String, FormatD1() As String
Dim FormatD2String As String, FormatD2() As String
Dim FormatD3String As String, FormatD3() As String
Dim MoneyStr As String, ReturnStr As String, TempStr As String
Dim pcount As Long
BasicDWString = "分,角,圆,拾,佰,仟,万,拾万,佰万,仟万,亿,拾亿,佰亿,仟亿,万亿,兆,拾兆,佰兆,仟兆,万兆,亿兆"
MoneyDWString = "零,壹,贰,叁,肆,伍,陆,柒,捌,玖"
FormatD1String = "拾万,佰万,仟万,拾亿,佰亿,仟亿,万亿,拾兆,佰兆,仟兆,万兆,亿兆"
FormatD2String = "拾,佰,仟,拾,佰,仟,万,拾,佰,仟,万,亿"
FormatD3String = "万,万,万,亿,亿,亿,亿,兆,兆,兆,兆,兆"
BasicDW = Split(BasicDWString, ",")
MoneyDW = Split(MoneyDWString, ",")
FormatD1 = Split(FormatD1String, ",")
FormatD2 = Split(FormatD2String, ",")
FormatD3 = Split(FormatD3String, ",")
MoneyStr = Format(NMoney, "0.00")
MoneyStr = Replace(MoneyStr, ".", "")
StrLen = Len(MoneyStr)
ReturnStr = ""
For X = 0 To StrLen - 1
TempStr = Mid(MoneyStr, StrLen - X, 1)
ReturnStr = MoneyDW(TempStr) & BasicDW(X) & ReturnStr
Next X
ReturnStr = Replace(ReturnStr, "零分", "")
ReturnStr = Replace(ReturnStr, "零角", "")
ReturnStr = Replace(ReturnStr, "零拾", "零")
ReturnStr = Replace(ReturnStr, "零佰", "零")
ReturnStr = Replace(ReturnStr, "零仟", "零")
ReturnStr = Replace(ReturnStr, "零万", "零")
ReturnStr = Replace(ReturnStr, "零亿", "零")
ReturnStr = Replace(ReturnStr, "零兆", "零")
Do
ReturnStr = Replace(ReturnStr, "零零", "零")
Loop While InStr(ReturnStr, "零零") <> 0
ReturnStr = Replace(ReturnStr, "零圆", "圆")
If Right(ReturnStr, 1) <> "圆" Then
ReturnStr = Replace(ReturnStr, "圆", "零")
ReturnStr = ReturnStr & "圆"
End If
ReturnStr = ReturnStr & "整"
For X = 0 To UBound(FormatD1)
pcount = InStr(1, ReturnStr, FormatD1(X), vbTextCompare)
If pcount > 0 Then
If InStr(pcount + 2, ReturnStr, FormatD3(X), vbTextCompare) > 0 Then
ReturnStr = Replace(ReturnStr, FormatD1(X), FormatD2(X))
End If
End If
Next X
pcount = InStr(1, ReturnStr, "万兆", vbTextCompare)
NMoneyToSMoney = ReturnStr
End Function