[求助]：在EXCELL中如何实现金额大写

ljwei692

我想在一张用EXCELL做的表上对金额一列求和，然后再用汉字大写表示出来，该如何实现呢？

andymark

visual basic 编译器中插入模块，把下列代码复制过去,在要显示大写金额的地方输入
=getdxje(G30)之类,就可以


Private Function Num2Char(ByVal I As Integer) As String
If I >= 0 And I <= 9 Then
Num2Char = Mid$("零壹贰叁肆伍陆柒捌玖", I + 1, 1)
Else
Num2Char = ""
End If
End Function
Private Function Num2RMB(ByVal sFourBitString As String, Optional _
ByVal sUnit As String = "元", Optional ByVal bMustHeader As _
Boolean = False) As String
'----------------------------------------------------------------------
Dim vNum, I, RX, BR, hdr
'------------------------------------------------------------------
BR = "仟佰拾元"
'------------------------------------------------------------------
vNum = Trim(Str(Val(sFourBitString))) ' 最多四位
'------------------------------------------------------------------
If (Len(vNum) < 4 And Len(vNum) > 0) And bMustHeader Then hdr = "零" _
Else hdr = ""
RX = ""
Do While Len(vNum) > 0
I = Right(vNum, 1)
If I > 0 Then
RX = Num2Char(I) + Right(BR, 1) + RX
Else
If Left(RX, 1) <> "零" Then RX = "零" + RX
End If
vNum = Left(vNum, Len(vNum) - 1)
BR = Left(BR, Len(BR) - 1)
Loop
RX = Left(RX, Len(RX) - 1)
If Right(RX, 1) = "零" Then ' 去除多余的零
RX = Left(RX, Len(RX) - 1)
End If
If Len(RX) > 0 Then
Num2RMB = hdr + RX + sUnit
Else
Num2RMB = RX + IIf(sUnit = "元", "元", "")
End If
End Function
Function Getdxje(ByVal Num As Currency) As String ' 得到大写金额
'----------------------------------------------------------------------
Dim vNum, vDec, ret, qb
'------------------------------------------------------------------
vNum = Right(Format$(Int(Num), "000000000000"), 12) ' 取十二位整数
vDec = Right(Format$(Int(Num * 100 + 0.5), "00"), 2) ' 取小数点后两位并自动四舍五入
'------------------------------------------------------------------
ret = Num2RMB(Left(vNum, 4), "亿", False)
If Len(ret) = 0 Then
ret = Num2RMB(Mid(vNum, 5, 4), "万", False)
Else
ret = ret + Num2RMB(Mid(vNum, 5, 4), "万", True)
End If
If Len(ret) = 0 Then
ret = Num2RMB(Right(vNum, 4), "元", False)
Else
ret = ret + Num2RMB(Right(vNum, 4), "元", True)
End If
'------------------------------------------------------------------
If ret = "元" Then
  ret = ""
  qb = ""
  Else
  qb = "xx"
End If
'------------------------------------------------------------------

If vDec = "00" And qb <> "" Then '1.00
    ret = ret + "整"
End If
If vDec = "00" And qb = "" Then '0.00
     ret = "(无金额)"
   
End If
   
If Left(vDec, 1) <> "0" And Right(vDec, 1) = 0 And qb <> "" Then '1.20
     ret = ret + Num2Char(Left(vDec, 1)) + "角整"
End If
If Left(vDec, 1) = "0" And Right(vDec, 1) <> 0 And qb <> "" Then '1.03
     ret = ret + "零" + Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) <> 0 And qb <> "" Then '1.23
     ret = ret + Num2Char(Left(vDec, 1)) + "角" + Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) = 0 And qb = "" Then '0.20
     ret = Num2Char(Left(vDec, 1)) + "角整"
End If
If Left(vDec, 1) = "0" And Right(vDec, 1) <> 0 And qb = "" Then '0.03
     ret = Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) <> 0 And qb = "" Then '0.23
     ret = Num2Char(Left(vDec, 1)) + "角" + Num2Char(Right(vDec, 1)) + "分"
End If
   
Getdxje = ret
'----------------------------------------------------------------------
End Function

ljwei692

谢谢！在EXCELL中可行吗？我试试吧

ljwei692

[em03]

[此贴子已经被作者于2003-10-17 14:32:08编辑过]

ADAM

在EXCEL中
儲存格--->數字---->類別---->特殊
里面就有了,
還有,你把EXCEL的操作貼到這里來,???????

ljwei692

不行，你看看这个结果：

只是把数字变成汉字大写，而没有变成：“壹仟零玖万玖仟玖佰陆拾叁圆捌拾玖分”样式
       

ADAM

哦....

ljwei692

引用代码模块会出现这种现象：
请问ADAM该如何解决呢？马上要用了，谢谢！

ADAM

很簡單,
表示函數名沒找到,
1.你是不是把函數名打錯了.
2.你有沒有把所有函數放在模組中....
呵呵....

andymark

因为你没有把函数加到模块上，是模块不是类模块