注册 登录
Office中国论坛/Access中国论坛 返回首页

todaynew的个人空间 http://www.office-cn.net/?144436 [收藏] [复制] [分享] [RSS]

日志

人民币大写函数

已有 844 次阅读2009-2-28 16:41 |个人分类:习作|


Function RMB(x As Double) As String
Dim i1 As Long, i2 As Long, j As Long, m As Long, strm(15) As String
Dim strB1 As String, strB2 As String
RMB = str(Round(x, 4))
j = InStr(1, RMB, ".", 1)
If j = 0 Then
    strB1 = Trim(RMB)
    strB2 = ""
Else
    strB1 = Trim(Mid(RMB, 1, j - 1))
    strB2 = Trim(Mid(RMB, j + 1, 4))
End If
strB1 = Replace(Replace(Replace(Replace(Replace(strB1, "0", "零"), "1", "壹"), "2", "貳"), "3", "叁"), "4", "肆")
strB1 = Replace(Replace(Replace(Replace(Replace(strB1, "5", "伍"), "6", "陆"), "7", "柒"), "8", "捌"), "9", "玖")
strB2 = Replace(Replace(Replace(Replace(Replace(strB2, "0", "零"), "1", "壹"), "2", "貳"), "3", "叁"), "4", "肆")
strB2 = Replace(Replace(Replace(Replace(Replace(strB2, "5", "伍"), "6", "陆"), "7", "柒"), "8", "捌"), "9", "玖")
i1 = Len(strB1): i2 = Len(strB2)
For j = 1 To i1
    strm(j) = Mid(strB1, i1 - j + 1, 1)
Next
strB1 = ""
For j = 1 To i1
    Select Case j
            Case 1
                If strm(j) = "零" Then
                    strB1 = strB1
                Else
                    strB1 = strm(j) & strB1
                End If
            Case 2
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "拾" & strB1
                End If
            Case 3
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "佰" & strB1
                End If
            Case 4
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "仟" & strB1
                End If
            Case 5
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        If strm(j) = "零" And strm(j + 1) = "零" And strm(j + 2) = "零" And strm(j + 3) = "零" Then
                            strB1 = strB1
                        Else
                            strB1 = "万" & strB1
                        End If
                    Else
                        strB1 = strm(j) & "万" & strB1
                    End If
                Else
                    strB1 = strm(j) & "万" & strB1
                End If
            Case 6
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "拾" & strB1
                End If
            Case 7
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "佰" & strB1
                End If
            Case 8
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "仟" & strB1
                End If
            Case 9
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        If strm(j) = "零" And strm(j + 1) = "零" And strm(j + 2) = "零" And strm(j + 3) = "零" Then
                            strB1 = strB1
                        Else
                            strB1 = "亿" & strB1
                        End If
                    Else
                        strB1 = strm(j) & "亿" & strB1
                    End If
                Else
                    strB1 = strm(j) & "亿" & strB1
                End If
            Case 10
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "拾" & strB1
                End If
            Case 11
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "佰" & strB1
                End If
            Case 12
                If strm(j) = "零" Then
                    If strm(j - 1) = "零" Then
                        strB1 = strB1
                    Else
                        strB1 = strm(j) & strB1
                    End If
                Else
                    strB1 = strm(j) & "仟" & strB1
                End If
    End Select
Next
Select Case i2
        Case 0
           strB2 = "整"
        Case 1
            strB2 = Mid(strB2, 1, 1) & "角" & "零分"
        Case 2
            strB2 = Mid(strB2, 1, 1) & "角" & Mid(strB2, 2, 1) & "分"
        Case 3
            strB2 = Mid(strB2, 1, 1) & "角" & Mid(strB2, 2, 1) & "分" & Mid(strB2, 3, 1) & "厘"
        Case 4
            strB2 = Mid(strB2, 1, 1) & "角" & Mid(strB2, 2, 1) & "分" & Mid(strB2, 3, 1) & "厘" & Mid(strB2, 4, 1) & "毫"
End Select
strB1 = strB1 & IIf(i1 = 0, "", "元")
If RMB = "0" Then
    RMB = ""
Else
    RMB = strB1 & strB2
End If
End Function

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-13 14:00 , Processed in 0.065176 second(s), 17 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部