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