自定义函数：阿拉伯数字转换中文大写数字

将下面的代码保存成bas文件，然后再VBE中导入成模块，即可使用此自定义函数RMBDX:[如＝RMBDX(A2)]
也可以将下面的代码直接复制进模块里，只要把生成模块时的第1、3、4行的红色字体删除就可使用此自定义函数RMBDX:[如＝RMBDX(A2)]

程序代码:
---------------------------------------------------------------------------------------
Attribute VB_Name = "小写数字转换大写"
Function RMBDX(value, Optional m = 1)
Attribute RMBDX.VB_Description = "函数功能：将阿拉伯数字转换中文大写数字！说明：本函数支持负数，不支持万兆以上的数值！当参数M=0时不支持四舍五入，当参数M=1时支持四舍五入，M默认值为1。"
Attribute RMBDX.VB_ProcData.VB_Invoke_Func = " \n14"

'阿拉伯数字转换中文大写数字源代码
'支持负数,支持小数点后的第三位数是进行四舍五入处理
'当参数M=0时不支持四舍五入,当参数M=1时支持四舍五入
'默认参数为1,即将小数点后的第三位数进行四舍五入处理
'不支持万兆以上的数值
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.WorksheetFun

ction.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 'Ii is OK,Very Good!
End If
End If
End Function
---------------------------------------------------------------------------------------

1.1、在工作表中可以运用RMBDX函数，如A1有数据，在B1输入＝RMBDX(A1),则金额自动转换成大写。


2.1、双击工程菜单下的Sheet1,输入代码,则可自动生成：
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address() <> "$A$1" Then Exit Sub
If .value = "" Or VBA.IsNumeric(.value) = False Then Exit Sub
.Offset(0, 1) = .value
.value = "大写金额：" & RMBDX(.value, "")
End With
End Sub
2.2、第三步的$A$1就是大写转换输入的单元格，可根据实际情况进行变换
.Offset(0, 1) = .value，0表示在同一行，1表示向左1列这样偏移，将小写金额定位，可自定义 .Offset(偏移行数,偏移列数) = .value，如不要小写金额，则可将此句删除。
.value = "大写金额：" & RMBJE(.value, "")，大写金额这四个字根据情况可以自行删除或保留。