将Excel中数字(76767.87)转换成大写中文
2009-07-30 21:11
387 查看
工具--》宏---》Visual Basic编辑器--->右击模块---》插入模块---》将代码复制到里面----》点击工具栏调试----》编译VBAProject---返回EXCEL中在单元格中输入=Change(数字单元格)
Function CChinese(StrEng As String) As String
'将阿拉伯数字转成中文字的程式例如:1560890 转成 "壹佰伍拾陆万零捌佰玖拾"。
'程式限制为不可输入超过16个数字
If Not IsNumeric(StrEng) Or StrEng Like "*.*" Or StrEng Like "*-*" Then
If Trim(StrEng) = "" Then MsgBox "无效的数字"
CChinese = "": Exit Function
End If
Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strTempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"
StrEng = CStr(CDec(StrEng))
intLen = Len(StrEng)
For intCounter = 1 To intLen
strTempCh = Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1, 1)
If strTempCh = "零" And intLen <> 1 Then
If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = ""
End If
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
End If
If (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCounter + 1) \ 4 + 1, 1)
If intCounter > 3 Then
If Mid(StrEng, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
End If
End If
strCh = strCh & Trim(strTempCh)
Next
CChinese = strCh
End Function
'===================================================================
'===================================================================
Function Change(money As String) As String
'实现货币金额中文大写转换的程序
'程式限制为不可输入超过16个数字
Dim x As String, y As String
Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码
Const letter = "0123456789sbqwy.zjf" '定义汉字缩写
Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟万亿圆整角分" '定义大写汉字
If CDbl(money) >= 1E+16 Then Change = "#VALUE!": 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贰佰零拾零肆)
y = Replace(y, "0j", "0") '避免零角
y = Replace(y, "0f", "") '避免零分
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(x < 0.1, Right(y, Len(y) - 3), y) '避免零几分(如:0.01零壹分;0.04零肆分)
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
Change = y
End Function
'===================================================================
Function CChinese(StrEng As String) As String
'将阿拉伯数字转成中文字的程式例如:1560890 转成 "壹佰伍拾陆万零捌佰玖拾"。
'程式限制为不可输入超过16个数字
If Not IsNumeric(StrEng) Or StrEng Like "*.*" Or StrEng Like "*-*" Then
If Trim(StrEng) = "" Then MsgBox "无效的数字"
CChinese = "": Exit Function
End If
Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strTempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"
StrEng = CStr(CDec(StrEng))
intLen = Len(StrEng)
For intCounter = 1 To intLen
strTempCh = Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1, 1)
If strTempCh = "零" And intLen <> 1 Then
If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = ""
End If
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
End If
If (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCounter + 1) \ 4 + 1, 1)
If intCounter > 3 Then
If Mid(StrEng, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
End If
End If
strCh = strCh & Trim(strTempCh)
Next
CChinese = strCh
End Function
'===================================================================
'===================================================================
Function Change(money As String) As String
'实现货币金额中文大写转换的程序
'程式限制为不可输入超过16个数字
Dim x As String, y As String
Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码
Const letter = "0123456789sbqwy.zjf" '定义汉字缩写
Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟万亿圆整角分" '定义大写汉字
If CDbl(money) >= 1E+16 Then Change = "#VALUE!": 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贰佰零拾零肆)
y = Replace(y, "0j", "0") '避免零角
y = Replace(y, "0f", "") '避免零分
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(x < 0.1, Right(y, Len(y) - 3), y) '避免零几分(如:0.01零壹分;0.04零肆分)
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
Change = y
End Function
'===================================================================
相关文章推荐
- Excel日期转换为大写中文数字
- excel中数字直接转换为中文大写
- 在英文版的excel中把数字转换成中文金额大写
- java实现金额数字转换为中文大写
- .Net/C#/VB/T-SQL/Java/Script 实现: 将天文数字转换成中文大写 (2000 年前的思路,打劫的,一点儿技术含量都没有)
- .Net/C#/VB/T-SQL/Java 实现: 将天文数字转换成中文大写 (2000 年前的思路,打劫的,一点儿技术含量都没有)
- 转 .Net/C#/VB/T-SQL/Java/Script 实现: 将天文数字转换成中文大写 (2000 年前的思路,打劫的,一点儿技术含量都没有)
- JavaScript将输入的数字金额转换成对应的中文大写金额
- javascript 数字如何转换成中文大写
- 将人民币数字转换为中文大写
- C#实现的【阿拉伯数字转换成中文大写金额】代码(原创)
- 一个将阿拉伯数字转换成中文大写的好算法【原创】(C#)
- qunar网2014年9月16日笔试题编程题3(中文大写数字转换成阿拉伯数字)题解
- 一个水晶报表的数字转换成中文大写的公式!
- 编程实现英文数字到中文大写数字的转换 分类: 编译原理 2014-06-02 15:15 541人阅读 评论(0) 收藏
- 阿拉伯数字转换成中文大写数字
- 数字转换成中文大写的经典方案
- 将天文数字转换成中文大写
- 数字金额转换中文大写Java实现
- [小技巧] 如何自动将阿拉伯数字转换为中文大写数字