人民币大小写转换 & 四舍五入函数

来源：互联网发布：绿盟科技java笔试题编辑：程序博客网时间：2024/06/05 05:39

人民币大小写转换代码

Public Function DaXie(txtJE As String) As String

On Error GoTo err1

Dim i As Long '循环变量

Dim K As Long '记录整数位循环位置

Dim NC As String '输入金额 '

Dim chrNum As String '保存从字串中取出的数字

Dim c1 As String '中文大写单位

Dim c2 As String '中文角分

Dim c3 As String '中文大写数字

Dim Zheng As String '整数部分

Dim Xiao As String '小数部分

NC = Trim(Format(txtJE, "##0.00"))

c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"

c2 = "角分"

c3 = "玖捌柒陆伍肆叁贰壹"

If NC = 0 Then

DaXie = "零元整"

Exit Function

End If

DaXie = ""

Zheng = Mid(NC, 1, (Len(NC) - 3))

Xiao = Mid(NC, (Len(Zheng) + 2), 2)

If Val(Xiao) <> 0 Then

For i = Len(Xiao) To 1 Step -1

chrNum = Mid(Xiao, i, 1)

If chrNum <> 0 Then

DaXie = Mid(c2, i, 1) & DaXie

DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie

Else

If i = 1 Then

DaXie = "零" & DaXie

End If

Next i

End If

K = 0

If Val(Zheng) <> 0 Then

DaXie = "元" & DaXie

For i = Len(Zheng) To 1 Step -1

If (Len(Zheng) - i) = 4 Then

If Val(Mid(Zheng, Len(Zheng) - 4, 1)) = 0 And _

Mid(DaXie, 1, 1) <> "零" And _

Mid(DaXie, 1, 1) <> "元" Then

DaXie = "零" & DaXie

If Len(Zheng) >= 9 Then

If Val(Mid(Zheng, Len(Zheng) - 7, 4)) = 0 Then

DaXie = DaXie

Else

DaXie = "万" & DaXie

End If

Else

DaXie = "万" & DaXie

End If

ElseIf (Len(Zheng) - i) = 8 Then

If Val(Mid(Zheng, Len(Zheng) - 8, 1)) = 0 And _

Mid(DaXie, 1, 1) <> "零" And _

Mid(DaXie, 1, 1) <> "元" Then

DaXie = "零" & DaXie

End If

DaXie = "亿" & DaXie

ElseIf (Len(Zheng) - i) = 12 Then

If Val(Mid(Zheng, Len(Zheng) - 12, 1)) = 0 And _

Mid(DaXie, 1, 1) <> "零" And _

Mid(DaXie, 1, 1) <> "元" Then

DaXie = "零" & DaXie

End If

DaXie = "万" & DaXie

End If

chrNum = Mid(Zheng, i, 1)

If chrNum <> 0 Then

If i = Len(Zheng) Then

DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie

Else

If (Len(Zheng) - i) <> 4 And _

(Len(Zheng) - i) <> 8 And _

(Len(Zheng) - i) <> 12 Then

DaXie = Mid(c1, (Len(c1) - K), 1) & DaXie

End If

DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie

End If

Else

If Mid(DaXie, 1, 1) <> "元" And _

Mid(DaXie, 1, 1) <> "万" And _

Mid(DaXie, 1, 1) <> "亿" Then

If Mid(DaXie, 1, 1) <> "零" Then

DaXie = "零" & DaXie

End If

K = K + 1

Next i

End If

If Right(Trim(DaXie), 1) <> "分" Then

DaXie = DaXie & "整"

End If

Exit Function

err1:

DaXie = ""

MsgBox "你输入的数字太长或者格式错误.", , "提示:"

End Function

Private Function myRound(ByVal sglT As Double, lngW As Long) As Double

On Error GoTo err1

'四舍五入函数

Dim lngN As Long '字符总长

Dim lngD As Long '记录小数点位置

Dim lngC As String '小数位数

Dim sglX As String '小数点后lngW-1位以前的数字

Dim lngX2 As Long '保存lngW位的数字(要保留的小数最未位)

Dim lngX3 As Long '保存lngW+1位的数字(要舍去的小数第一位)

Dim sglN As String

'计算小数点位置

sglN = CStr(sglT)

lngD = InStr(sglN, ".")

If lngD = 0 Then

myRound = sglN

Else

lngN = Len(sglN)

sglN = Left(sglN, lngD + lngW + 1)

sglX = Left(sglN, lngD + (lngW - 1))

lngC = Len(Mid(sglN, lngD + 1, Len(sglN) - lngD))

If lngC > lngW Then

lngX2 = Mid(sglN, lngD + lngW, 1)

lngX3 = Mid(sglN, lngD + lngW + 1, 1)

If lngX3 > 4 Then lngX2 = lngX2 + 1

If lngW = 1 Then

myRound = sglX & "." & lngX2

Else

myRound = sglX & lngX2

End If

Else

myRound = CDbl(sglN)

End If

Exit Function

err1:

MsgBox "未知错误!", 48, "myRound:"