VBA 数字金额转汉字大写金额自定义函数

rendiule01

EXCEL 数字金额（79592.64） 转换汉字大写金额 (柒万玖仟伍佰玖拾贰元陆角肆分)


用
=TEXT(J15,"[dbnum2]")   
柒万玖仟伍佰玖拾贰.陆肆

=NUMBERSTRING(J15,2)
柒万玖仟伍佰玖拾叁

用自定义格式
柒万玖仟伍佰玖拾贰.陆肆

都不是我想要的格式
柒万玖仟伍佰玖拾贰元陆角肆分

skiss

分享一个收藏前辈们写的自定义函数，简单模拟了一下，可以实现你需要的，供参考。

ykcbf1100

人民币大写自定义函数，不是我写的，但能用，供参考。

3190496160

Public Function jedx(curmoney As Currency) As String 'currency改为Range
Dim curmoney1 As Long
Dim i1 As Long
Dim i2 As Integer
Dim i3 As Integer
Dim s1 As String, s2 As String, s3 As String
curmoney1 = Round(curmoney * 100)
i1 = Int(curmoney1 / 100)
i2 = Int(curmoney1 / 10) - i1 * 10
i3 = curmoney1 - i1 * 100 - i2 * 10
s1 = Application.WorksheetFunction.Text(i1, "[dbnum2]")
s2 = Application.WorksheetFunction.Text(i2, "[dbnum2]")
s3 = Application.WorksheetFunction.Text(i3, "[dbnum2]")
s1 = s1 & "元"
If i3 <> 0 And i2 <> 0 Then
s1 = s1 & s2 & "角" & s3 & "分"
If i1 = 0 Then
s1 = s2 & "角" & s3 & "分"
End If
End If
If i3 = 0 And i2 <> 0 Then
s1 = s1 & s2 & "角整"
If i1 = 0 Then
s1 = s2 & "角整"
End If
End If
If i3 <> 0 And i2 = 0 Then
s1 = s1 & s2 & s3 & "分"
If i1 = 0 Then
s1 = s3 & "分"
End If
End If
If Right(s1, 1) = "元" Then s1 = s1 & "整"
jedx = s1
End Function

CNS1993

推荐：以前老师写的小写转大写函数
Cells(15, 3).FormulaR1C1 = DX(Cells(15, 8))

Function DX(M)
    DX = Replace(Application.text(Round(M + 0.00000001, 2), "[DBnum2]"), ".", "元")
    DX = IIf(left(right(DX, 3), 1) = "元", left(DX, Len(DX) - 1) & "角" & right(DX, 1) & "分", IIf(left(right(DX, 2), 1) = "元", DX & "角整", IIf(DX = "零", "", DX & "元整")))
    DX = Replace(Replace(Replace(Replace(DX, "零元零角", ""), "零元", ""), "零角", "零"), "-", "负")
End Function

gjj136138139

Function aaaaMyDaXie(ByVal rng As Range)
Dim M
'Stop
M = rng.Value
Y = Int(Round(100 * Abs(M)) / 100)
j = Round(100 * Abs(M) + 0.00001) - Y * 100
f = Round((j / 10 - Int(j / 10)) * 10)
A = IIf(Y < 1, "", Application.Text(Y, "[DBNum2]") & "元")
B = IIf(j > 9.4, Application.Text(Int(j / 10), "[DBNum2]") & "角", IIf(Y < 1, "", IIf(f > 0.4, "零", "")))
C = IIf(f < 1, "整", Application.Text(Round(f, 0), "[DBNum2]") & "分")
aaaaMyDaXie = IIf(Abs(M) < 0.005, "", IIf(M < 0, "负" & A & B & C, A & B & C))
End Function

zpy2

=WEBSERVICE("http://e.anyoupin.cn/eh3/?rmb_fmt~" & A2)

feilanga

1. Public Function YuanCapital(Amountin)
   
2.     YuanCapital = Replace(Application.Text(Round(Amountin + 0.00000001, 2), "[DBnum2]"), ".", "元")
   
3.     YuanCapital = IIf(Left(Right(YuanCapital, 3), 1) = "元", Left(YuanCapital, Len(YuanCapital) - 1) & "角" & Right(YuanCapital, 1) & "分", IIf(Left(Right(YuanCapital, 2), 1) = "元", YuanCapital & "角整", IIf(YuanCapital = "零", "", YuanCapital & "元整")))
   
4.     YuanCapital = Replace(Replace(Replace(Replace(YuanCapital, "零元零角", ""), "零元", ""), "零角", "零"), "-", "负")
   
5. End Function

复制代码

不知道谁写的

熊excelhome

WPS自带格式就行，单元格.value还能参与计算。

microyip

公式变通一下，可以吗？

1. =TEXT(INT(J15),"[dbnum2]") & "元" & IF(INT(J15)=J15,"",TEXT(RIGHT(INT(J15*10),1),"[dbnum2]") & "角" & IF(INT(J15*10)=J15*10,"",TEXT(RIGHT(INT(J15*100),1),"[dbnum2]") & "分"))

复制代码