VBA数字转换中文货币大写

合集下载
  1. 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。

《VBA数字转换中文货币大写》
使用说明:
本程序可在各种支持VBA语言的软件上直接使用,其中MS Excel和MS Access已成功测试。

(把程序复制到VBA编程器里即可直接使用)
程序使用方法如下图:
程序:
Public Function CRMB(ByVal StrRMB As String) As String
Dim i As Long, k As Long, j As Long, N As Long
Dim RMB As String, intString As String, decString As String, tmpString() As String, cnNumber() As String, cnUnit() As String
On Error GoTo cnstr_err:
'初始化中文数字、单位
cnNumber = Split("零,壹,贰,叁,肆,伍,陆,柒,捌,玖", ",")
cnUnit = Split("分,角,元,拾,佰,仟,万,拾,佰,仟,亿,拾,佰,仟,兆,拾,佰,仟,京,拾,佰,仟,垓,拾,佰,仟", ",") decString = ""
intString = StrRMB
tmpString = Split(StrRMB, ".")
If UBound(tmpString) Then
intString = tmpString(0)
decString = tmpString(1)
End If
intString = intString & Left(decString & "00", 2)
k = Len(intString) - 1
If k > 25 Then 'Len(cnUnit) - 1
RMB = StrRMB '超出转换范围,返回原值
Else
If Val(intString) = 0 Then
RMB = ""
Else
For i = 0 To k
j = Val(Mid(intString, i + 1, 1))
RMB = RMB & cnNumber(j) & cnUnit(k - i) Next i
RMB = Replace(RMB, "零分", "零")
RMB = Replace(RMB, "零角", "零")
RMB = Replace(RMB, "零拾", "零")
RMB = Replace(RMB, "零佰", "零")
RMB = Replace(RMB, "零仟", "零")
RMB = Replace(RMB, "零零零", "零")
RMB = Replace(RMB, "零零", "零")
RMB = Replace(RMB, "零元", "元")
RMB = Replace(RMB, "零万", "万")
RMB = Replace(RMB, "零亿", "亿")
RMB = Replace(RMB, "零兆", "兆")
RMB = Replace(RMB, "零京", "京")
RMB = Replace(RMB, "零垓", "垓")
RMB = Replace(RMB, "垓京兆亿万", "垓")
RMB = Replace(RMB, "垓京兆亿", "垓")
RMB = Replace(RMB, "京兆亿万", "京")
RMB = Replace(RMB, "垓京兆", "垓")
RMB = Replace(RMB, "京兆亿", "京")
RMB = Replace(RMB, "兆亿万", "兆")
RMB = Replace(RMB, "垓京", "垓")
RMB = Replace(RMB, "垓兆", "垓")
RMB = Replace(RMB, "垓亿", "垓")
RMB = Replace(RMB, "垓万", "垓")
RMB = Replace(RMB, "京兆", "京")
RMB = Replace(RMB, "京亿", "京")
RMB = Replace(RMB, "京万", "京")
RMB = Replace(RMB, "兆亿", "兆")
RMB = Replace(RMB, "兆万", "兆")
RMB = Replace(RMB, "亿万", "亿")
If Right(RMB, 2) = "元零" Then '整元时
RMB = Left(RMB, Len(RMB) - 1) & "整"
ElseIf Right(RMB, 2) = "角零" Then '有角或分时RMB = Left(RMB, Len(RMB) - 1)
End If
End If
cnstr_exit: CRMB = RMB Exit Function cnstr_err:
RMB = "" Resume cnstr_exit End Function。

相关文档
最新文档