2015-12-10 · 知道合伙人软件行家
一、自定义VBA函数:
Function RMBdx(Optional Mynum As Variant)
'原创:生哥
'来源:www.vip968.com 七彩阳光
'功能:根据数值返回人民币的大写金额。
If IsNumeric(Mynum) = False Then 'IsNumeric() 判断是否为数字
Mynum = 0
End If
Mynum = Round(Mynum, 2) '将数字保留2位小数
If Sgn(Mynum) = 0 Then '判断数字是否为负数,=1为正,=0为零,=-1为负
RMBdx = "" '数字为0,则不显示,如需显示其它信息,请自行修改,如改为 RMBdx = "零圆"
Else
RMBdx = IIf(Sgn(Mynum) = -1, "负", "") & Application.Text(Int(Abs(Mynum)), "[=]g;[dbnum2]") & "圆" '若为负数,则在前加“负”字
If Abs(Mynum) - Int(Abs(Mynum)) > 0 Then '判断数字是否为带小数点
RMBdx = RMBdx & Application.Text(Right(Format(Abs(Mynum) - Int(Abs(Mynum)), "0.00"), 2), "[=]g;[dbnum2]0角0分") '转换小数点后数字
RMBdx = Replace(Replace(RMBdx, "零分", ""), "零角", "零") '如出现“零角”则替换为“零”,如出现“零分”则清除,如需显示“角整”则使用下边一行。
'RMBdx = Replace(Replace(RMBdx, "零分", "整"), "零角", "零") '如出现“零角”则替换为“零”,如出现“零分”则清除,如需显示“角整”则使用本行。
Else
RMBdx = RMBdx & "整"
End If
End If
End Function
二、直接使用公式的最简单方法:
1、显示“角整”
如“10.20元”显示为“壹拾圆贰角整”
=IF(ROUND(A1,2)=0,"",IF(A1<0,"负","")&IF(ABS(A1)>=1,TEXT(INT(ROUND(ABS(A1),2)),"[dbnum2]")&"圆","")&SUBSTITUTE(SUBSTITUTE(TEXT(RIGHT(RMB(A1,2),2),"[dbnum2]0角0分;;整"),"零角",IF(A1^2<1,,"零")),"零分","整"))
2、不显示“角整”
如“10.20元”显示为“壹拾圆贰角”
=IF(ROUND(A1,2)=0,"",IF(A1<0,"负","")&IF(ABS(A1)>=1,TEXT(INT(ROUND(ABS(A1),2)),"[dbnum2]")&"圆","")&SUBSTITUTE(SUBSTITUTE(TEXT(RIGHT(RMB(A1,2),2),"[dbnum2]0角0分;;整"),"零角",IF(A1^2<1,,"零")),"零分",""))
三、用上述方法验证如图:
c2公式:=rmbdx(B2)
d2公式:=IF(ROUND(B2,2)=0,"",IF(B2<0,"负","")&IF(ABS(B2)>=1,TEXT(INT(ROUND(ABS(B2),2)),"[dbnum2]")&"圆","")&SUBSTITUTE(SUBSTITUTE(TEXT(RIGHT(RMB(B2,2),2),"[dbnum2]0角0分;;整"),"零角",IF(B2^2<1,,"零")),"零分","整"))
e2公式:=IF(ROUND(B2,2)=0,"",IF(B2<0,"负","")&IF(ABS(B2)>=1,TEXT(INT(ROUND(ABS(B2),2)),"[dbnum2]")&"圆","")&SUBSTITUTE(SUBSTITUTE(TEXT(RIGHT(RMB(B2,2),2),"[dbnum2]0角0分;;整"),"零角",IF(B2^2<1,,"零")),"零分",""))
我觉得这个别人已经写的很好了,这是我的学习笔记。看到这个问题就贴出来。
第三部分确实是我刚写的公式。
不用的话就删吧。
=SUBSTITUTE(SUBSTITUTE(IF(ISNUMBER(FIND(".",A1)),TEXT(LEFT(A1,FIND(".",A1)-1),"[dbnum2]")&"元"&TEXT(MID(A1,FIND(".",A1)+1,1),"[dbnum2]")&"角"&TEXT(MID(A1,FIND(".",A1)+2,1),"[dbnum2]")&"分",TEXT(A1,"[dbnum2]")&"元整"),"角分","角整"),"-","负")
格式柄下拉复制公式
1.利用excel编程语言写的宏代码如下:
Sub n2rmb()
Dim cel As Range
Dim str As Variant
Dim m, n
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For Each cel In Selection
If Not cel.Text Like "*.*" Then
cel.Offset(0, 1) = WorksheetFunction.Text(Val(cel.Text), "[dbnum2]") & "元整"
GoTo line1
End If
str = Split(cel.Text, ".")
m = Val(str(0))
m = WorksheetFunction.Text(m, "[dbnum2]") & "元"
n = str(1)
If Len(n) = 2 Then
n1 = WorksheetFunction.Text(Val(Left(n, 1)), "[dbnum2]") & "角"
n2 = WorksheetFunction.Text(Val(Mid(n, 2, 1)), "[dbnum2]") & "分"
n = n1 & n2
Else
n = WorksheetFunction.Text(Val(str(1)), "[dbnum2]") & "角"
End If
cel.Offset(0, 1) = m & n
line1:
cel.Offset(0, 1).HorizontalAlignment = xlCenter
cel.Offset(0, 1).EntireColumn.AutoFit
Next cel
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
2.运行该代码的效果图如下: