ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何定义阿拉伯数字金额转换为会计大写中文金额的自定义函数?

如何定义阿拉伯数字金额转换为会计大写中文金额的自定义函数?

作者:绿色风 分类: 时间:2022-08-17 浏览:76
楼主
BIN_YANG168
Q:怎样用自定义函数转换阿拉伯数字金额转换为会计大写中文金额,如:123.45 变为:壹佰贰拾叁元肆角伍分
A
:按Alt+F11,插入模块VBE窗口中输入以下代码:
  1. Function DaXie(ByVal Num)       ' 人民币中文大写函数
  2.     Application.Volatile True
  3.     Place = "分角元拾佰仟万拾佰仟亿拾佰仟万"
  4.     Dn = "壹贰叁肆伍陆柒捌玖"
  5.     D1 = "整零元零零零万零零零亿零零零万"
  6.     If Num < 0 Then FuHao = "(负)"
  7.     Num = Format(Abs(Num), "###0.00") * 100
  8.     If Num > 999999999999999# Then: DaXie = "数字超出转换范围!!": Exit Function
  9.     If Num = 0 Then: DaXie = "零元零分": Exit Function
  10.     NumA = Trim(Str(Num))
  11.     NumLen = Len(NumA)
  12.     For J = NumLen To 1 Step -1     ' 数字转换过程
  13.       Temp = Val(Mid(NumA, NumLen - J + 1, 1))
  14.       If Temp <> 0 Then             ' 非零数字转换
  15.          NumC = NumC & Mid(Dn, Temp, 1) & Mid(Place, J, 1)
  16.       Else                          ' 数字零的转换
  17.          If Right(NumC, 1) <> "零" Then
  18.            NumC = NumC & Mid(D1, J, 1)
  19.          Else
  20.            Select Case J            ' 特殊数位转换
  21.                 Case 1
  22.                   NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1)
  23.                 Case 3, 11
  24.                   NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1) & "零"
  25.                 Case 7
  26.                   If Mid(NumC, Len(NumC) - 1, 1) <> "亿" Then
  27.                      NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1) & "零"
  28.                   End If
  29.                 Case Else
  30.            End Select
  31.          End If
  32.       End If
  33.     Next
  34.     DaXie = FuHao & Trim(NumC)
  35. End Function


然后在A1单元格输入需要的数字,在其他单元格输入=DAXIE (A1)即可。

数字金额转换中文大写.rar
2楼
xyf2210
这个有用,记下

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap