[挑战]功能最全、最短（7行）的人民币大写函数

烟雨厦江南

EXCEL有个王八的屁股（龟腚），对于4舍5入的规定中，5是特殊处理的，若前一位是偶数，则5舍，若前一位为奇数，则5入，楼主试试1,388,999,999.715,2,388,999,999.735的结果看看

rzz8118

谢谢,佩服!!

ldy888

这个龟腚太不能理解了

SWFWIND

好东西！~谢谢分享！

edwu

我发一个网上常见的。

A. 使用方法：

在EXECL的“工具”菜单中，选择“加载宏”，将这两个文件加载进去，就可以实现数字转人民币大写了。

 

注：文件名为：RBM带小数.xla和RMB不带小数.xla

 

 

EXECL引用函数语法：

 

带小数：RMBpiont(单元格位置），比如是D12，函数写法为：=RMBpiont(D12)

不带小数：RMBdx(单元格位置），比如是D12，函数写法为：=RMBdx(D12)

 

附源码:

不带小数:

Function rmbdx(value, Optional m = 0)
On Error Resume Next
Dim a
Dim jf As String   '定义角分位
Dim j '定义角位
Dim f '定义分位
If value < 0 Then '处理正负数的情况
a = "负"
Else
a = ""
End If

If IsNumeric(value) = False Then '判断待转换的value是否为数值
rmbdx = "需转换的内容非数值"
Else
 value = Abs(CCur(value))
'当参数m不输入(默认为0)或为0时,小数点后的第三数不进行四舍五入处理
'当参数m为1或其它数值时,小数点后的第三数进行四舍五入处理
 If m = 0 Then
   jf = Fix((value - Fix(value)) * 100)
   value = Fix(value) + jf / 100
   Else '厘位进行四舍五入实践很少用到,但还是要照顾到
     value = Application.WorksheetFunction.Round(value, 2) '-->这句是关键!只用round有bug
     jf = Round((value - Fix(value)) * 100, 0)
 End If
 If value = 0 Or value = "" Then '当待转换数值为0或空时,不进行转换
 rmbdx = ""
 Else
 strrmbdx = Application.WorksheetFunction.Text(Int(value), "[DBNum2]") & "元" '转换整数位
   If Int(value) = 0 Then
   strrmbdx = ""
   End If
 If Int(value) <> value Then

     strrmbdx = strrmbdx & "整"
 End If

 rmbdx = a & strrmbdx '最后成型
 End If
End If
End Function

 

带小数:

Function RMBpiont(value, Optional m = 0)
On Error Resume Next
Dim a
Dim jf As String   '定义角分位
Dim j '定义角位
Dim f '定义分位
If value < 0 Then '处理正负数的情况
a = "负"
Else
a = ""
End If

If IsNumeric(value) = False Then '判断待转换的value是否为数值
RMBpiont = "需转换的内容非数值"
Else
 value = Abs(CCur(value))
'当参数m不输入(默认为0)或为0时,小数点后的第三数不进行四舍五入处理
'当参数m为1或其它数值时,小数点后的第三数进行四舍五入处理
 If m = 0 Then
   jf = Fix((value - Fix(value)) * 100)
   value = Fix(value) + jf / 100
   Else '厘位进行四舍五入实践很少用到,但还是要照顾到
     value = Application.WorksheetFunction.Round(value, 2) '-->这句是关键!只用round有bug
     jf = Round((value - Fix(value)) * 100, 0)
 End If
 If value = 0 Or value = "" Then '当待转换数值为0或空时,不进行转换
 RMBpiont = ""
 Else
 strRMBpiont = Application.WorksheetFunction.Text(Int(value), "[DBNum2]") & "元" '转换整数位
   If Int(value) = 0 Then
   strRMBpiont = ""
   End If
 If Int(value) <> value Then
   If jf > 9 Then '判断小数位
     j = Left(jf, 1)
     f = Right(jf, 1)
     Else
     j = 0
     f = jf
   End If

  If j <> 0 And f <> 0 Then '角分位都有时
    jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角" _
    & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
     Else
      '处理出现零几分的情况
      If Int(value) = 0 And j = 0 And f <> 0 Then
         jf = Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
         Else
           If j = 0 Then '有分无角时
            jf = "零" & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
              Else
               If f = 0 Then '有角无分时
                jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角整"
               End If
           End If
      End If
  End If
  strRMBpiont = strRMBpiont & jf '组装
 Else
     strRMBpiont = strRMBpiont & "整"
 End If

 RMBpiont = a & strRMBpiont '最后成型
 End If
End If
End Function

 

pdadet

Application.Text(y, "[DBNum2]") 这个写成

Application.WorksheetFunction.Text(y, "[DBNum2]")

很多人就能看懂了

轻风

历害啊

sbynkidt

好東西應該給大家分享，早知道我也貼出來了。

fenghcl

以前一直想做，但是都想不到有那么简单的算法，实在方便又实用，谢谢！

abcd321abcd

不错！！最好做个注释吧!!!!!!!!!!