求助:如何在EXCEL中用宏编写货币金额小写转换大写的宏

LZSHENG

明媚

这个问题老早人家就给解了，我抄来了再给你试试吧！

Function rmbdx(value, Optional m = 0)
'中文大写源代码,By 对面男孩、redwin
'支持负数,支持小数点后的第三位数是否进行四舍五入处理
'默认参数为0,即不将小数点后的第三位数进行四舍五入处理
'2002-10-11--2002-10-13
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
   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
  strrmbdx = strrmbdx & jf '组装
Else
     strrmbdx = strrmbdx & "整"
End If

rmbdx = a & strrmbdx '最后成型了,各位MM满意了吧
End If
End If
End Function

sunnet

以下是引用明媚在2003-5-14 16:41:19的发言：
……
最后成型了,各位MM满意了吧
……

您倒是“一丝不苟”，连这个也一齐贴上来了！

LZSHENG

谢谢！
Application.WorksheetFunction.Text(j, "[DBNum2]") 这是一个函数码？我知道结果是小写转大写"[DBNum2]" 是什么意思？但在我测试时有些不符合逻辑如101001.00元返回值为壹万壹仟零壹元正,应为壹万零壹仟零壹元正.

hanjianguo

谢谢！我正需要。

yk-z

thanks!!!

LAO_DI

够强，交个朋友好么？呵呵。。。david.di@sandvik.com [em04][em04][em04][em04]

HCH

非常感谢

yyyu_2000

我试试

sbynkidt

<P>   <B></B>
谢谢！
Application.WorksheetFunction.Text(j, "[DBNum2]") 这是一个函数码？我知道结果是小写转大写"[DBNum2]" 是什么意思？但在我测试时有些不符合逻辑如101001.00元返回值为壹万壹仟零壹元正,应为壹万零壹仟零壹元正.

</P><P>你搞错了吧！应是壹拾万壹千零壹元整！</P><P>这个好啊！</P><P>Function NtoC(ByVal n) As String   'n as Currency
  Const cNum As String = "零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分"
  Const cCha As String = "零仟零佰零拾零零零零零亿零万零元亿万零角零分零整-零零零零零亿万元亿零整整"
  Dim sNum As String
  Dim i As Long</P><P>  If (n &lt;&gt; 0) And (Abs(n) &lt; 10000000000000#) Then
    sNum = Trim(Str(Int(Abs(n) * 100)))
    For i = 1 To Len(sNum) '逐位转换
      NtoC = NtoC + Mid(cNum, (Mid(sNum, i, 1)) + 1, 1) + Mid(cNum, 26 - Len(sNum) + i, 1)
    Next
    For i = 0 To 11 '去掉多余的零
      NtoC = Replace(NtoC, Mid(cCha, i * 2 + 1, 2), Mid(cCha, i + 26, 1))
    Next
    If n &lt; 0 Then NtoC = "(负)" + NtoC
  Else
    NtoC = IIf(n = 0, "零元", "溢出")
  End If
End Function</P>