(EXCEL)小写金额转换为中文大写金额

(EXCEL宏）小写金额转换为中文大写金额

EXCEL本身提供将数字转换为大写表示的功能,没有元角份，不能应用于财务。要将小写金额转换为中文大写金额，可用以下三种方法：

方法1：

通过在EXCEL表格框（例如在“B1”单元）中直接输入以下公式：

=IF(A1<0,"金额为负无效",

(IF(OR(A1=0,A1=""),"(人民币)零元",

IF(A1<1,"(人民币)",

TEXT(INT(A1),"[dbnum2](人民币)G/通用格式")&"元"))))&

IF(

(INT(A1*10)-INT(A1)*10)=0,

IF(INT(A1*100)-INT(A1*10)*10=0,"","零"),

(TEXT(INT(A1*10)-INT(A1)*10,"[dbnum2]")&"角"))

&IF(

(INT(A1*100)-INT(A1*10)*10)=0,"整",

TEXT((INT(A1*100)-INT(A1*10)*10),"[dbnum2]")&"分")

然后在“A1”中输入数字，就可看到效果。

(若要在后面加句号，可在以上代码后加：&"。")

 

方法2：

通过VBA（宏）输入转换公式: 点击菜单“工具”->“宏”->“VisualBasic编辑器”,在编辑器窗口中，点击菜单“插入”->“模块”，在出现的窗口中输入以下内容：

Function daxie(ByVal Num)       ' 人民币中文大写函数
    Application.Volatile True
    Place = "分角元拾佰仟万拾佰仟亿拾佰仟万"
    Dn = "壹贰叁肆伍陆柒捌玖"
    D1 = "整零元零零零万零零零亿零零零万"
    If Num < 0 Then FuHao = "（负）"
    Num = Format(Abs(Num), "###0.00") * 100
    If Num > 999999999999999# Then: daxie = "数字超出转换范围!!": Exit Function
    If Num = 0 Then: daxie = "零元零分": Exit Function
    NumA = Trim(Str(Num))
    NumLen = Len(NumA)
    For J = NumLen To 1 Step -1     ' 数字转换过程
      temp = Val(Mid(NumA, NumLen - J + 1, 1))
      If temp <> 0 Then             ' 非零数字转换
         NumC = NumC & Mid(Dn, temp, 1) & Mid(Place, J, 1)
      Else                          ' 数字零的转换
         If Right(NumC, 1) <> "零" Then
           NumC = NumC & Mid(D1, J, 1)
         Else
           Select Case J            ' 特殊数位转换
                Case 1
                  NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1)
                Case 3, 11
                  NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1) & "零"
                Case 7
                  If Mid(NumC, Len(NumC) - 1, 1) <> "亿" Then
                     NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1) & "零"
                  End If
                Case Else
           End Select
         End If
      End If
    Next
    daxie = "(人民币)" & FuHao & Trim(NumC)
End Function

然后切换回excel,在“A2”单元中输入数字，在“B2”单元中输入：“=DaXie(A2)”，就可看到效果。

方法3：

同样是通过VBA公式，方法同上，公式如下：

Function daxie1(money As String) As String '
Dim x As String, y As String
Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码
Const letter = "0123456789sbqwy.zjf" '定义汉字缩写
Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟萬億圆整角分" '定义大写汉字
Dim temp As String
temp = money
If InStr(temp, ".") > 0 Then temp = Left(temp, InStr(temp, ".") - 1)

If Len(temp) > 16 Then MsgBox "数目太大，无法换算！请输入一亿亿以下的数字", 64, "错误提示": Exit Function '只能转换一亿亿元以下数目的货币！

x = Format(money, "0.00") '格式化货币
y = ""
For i = 1 To Len(x) - 3
y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)
Next
If Right(x, 3) = ".00" Then
y = y & "z" '***元整
Else
y = y & Left(Right(x, 2), 1) & "j" & Right(x, 1) & "f" '*元*角*分
End If
y = Replace(y, "0q", "0") '避免零千(如：40200肆萬零千零贰佰)
y = Replace(y, "0b", "0") '避免零百(如：41000肆萬壹千零佰)
y = Replace(y, "0s", "0") '避免零十(如：204贰佰零拾零肆)

Do While y <> Replace(y, "00", "0")
y = Replace(y, "00", "0") '避免双零(如：1004壹仟零零肆)
Loop
y = Replace(y, "0y", "y") '避免零億(如：210億 贰佰壹十零億)
y = Replace(y, "0w", "w") '避免零萬(如：210萬 贰佰壹十零萬)
y = IIf(Len(x) = 5 And Left(y, 1) = "1", Right(y, Len(y) - 1), y) '避免壹十(如：14壹拾肆；10壹拾)
y = IIf(Len(x) = 4, Replace(y, "0.", ""), Replace(y, "0.", ".")) '避免零元(如：20.00贰拾零圆；0.12零圆壹角贰分)

For i = 1 To 19
y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字
Next
daxie1 = "(人民币)" & y
End Function

切换回excel,在“A3”单元中输入数字，在“B3”单元中输入：“=DaXie1(A3)”，就可看到效果。

实现的效果比较如下：

1234.5	(人民币)壹仟贰佰叁拾肆元伍角整	直接公式
1234.5	(人民币)壹仟贰佰叁拾肆元伍角整	DaXie(A2)
1234.5	(人民币)壹仟贰佰叁拾肆圆伍角零分	DaXie1(A3)