如果将小写金额转换成大写金额？

http://search.csdn.net/expert/topic/51/5101/2002/8/2/918115.htm

'转换阿拉伯数字为中文人民币大写--------------------------------------------
'调用:Msgbox NtoC(123.45)
Public Function NtoC(ByVal sNum As String, _
    Optional BITs As String = ",拾,佰,仟", _
    Optional UNITs As String = ",[万],[亿],[兆],[万兆]", _
    Optional ByVal Yuan As String = "圆", _
    Optional ByVal Jiao As String = "角", _
    Optional ByVal Fen As String = "分") As String

    sNum = sNum
    If Val(sNum) < 0 Then
        NtoC = "零" & Yuan
        Exit Function
    End If


    Dim sIntD, sDecD As String
    Dim i, iCount, j, iLength As Integer
    Dim lStartPos As Long
    Dim sBIT() As String, sUNIT() As String, sCents(2) As String

    sBIT = VBA.Split(BITs, ",")
    sUNIT = VBA.Split(UNITs, ",")
    sCents(0) = Fen
    sCents(1) = Jiao
    Dim temp As String
    If InStr(sNum, ".") > 0 Then
        temp = Left(sNum, InStr(sNum, ".") - 1)
    Else
        temp = sNum
    End If
    iCount = IIf(Len(temp) Mod 4, Len(Trim(temp)) \ 4 + 1, Len(Trim(temp)) \ 4)
    lStartPos = 1
    For i = iCount To 1 Step -1
        If i = iCount And Len(Trim(temp)) Mod 4 <> 0 Then
            iLength = Len(Trim(temp)) Mod 4
        Else
            iLength = 4
        End If
        sIntD = Mid(Trim(temp), lStartPos, iLength)
        For j = 1 To Len(Trim(sIntD))
            If Val(Mid(sIntD, j, 1)) <> 0 Then
                NtoC = NtoC & Choose(Val(Mid(sIntD, j, 1)), _
                    "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖") & _
                    sBIT(Len(Trim(sIntD)) - j)
            Else
                If Val(Mid(sIntD, j + 1, 1)) <> 0 Then
                    NtoC = NtoC & "零"
                End If
            End If
        Next j
        lStartPos = lStartPos + iLength
        If i < iCount Then
            If (Val(Mid(sIntD, Len(Trim(sIntD)), 1)) <> 0 Or _
                Val(Mid(sIntD, Len(Trim(sIntD)) - 1, 1)) <> 0 Or _
                Val(Mid(sIntD, Len(Trim(sIntD)) - 2, 1)) Or _
                Val(Mid(sIntD, Len(Trim(sIntD)) - 3, 1)) <> 0) Then
                If i < UBound(sUNIT) + 1 Then
                    NtoC = NtoC & sUNIT(i - 1)
                    'Else
                    'NtoC = NtoC & sUNIT(i - 1)
                End If
            End If
        Else
        'If i < UBound(sUNIT) + 1 Then
            NtoC = NtoC & sUNIT(i - 1)
        'End If
        End If
    Next
    If Len(Trim(NtoC)) > 0 Then
        NtoC = NtoC & Yuan
    End If
    '小数
    If InStr(1, sNum, ".") <> 0 Then
        sDecD = Right(sNum, Len(sNum) - InStr(1, sNum, "."))
        For i = 1 To Len(Trim(sDecD))
            If Val(Mid(Trim(sDecD), i, 1)) <> 0 Then
                NtoC = NtoC & Choose(Val(Mid(Trim(sDecD), i, 1)), _
                    "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
                NtoC = NtoC & sCents(2 - i)
                If i >= 2 Then Exit For
            Else
                If Len(Trim(NtoC)) > 0 Then NtoC = NtoC & "零"
            End If
        Next i
    Else
        NtoC = NtoC & "整"
    End If
End Function

如何将数字转换为大写中文？这个读数程序可以支持无限长有限小数，希望大家一测：
Const strN = "零壹贰叁肆伍陆柒捌玖"
Const strG = "拾佰仟万亿"
Const intN = "0123456789"
Dim Zero_Count As Long '读零计数
'
Private Function GetN(ByVal N As Long) As String
GetN = Mid(strN, N + 1, 1)
End Function
Private Function GetG(ByVal G As Long) As String
Select Case G
Case 1
GetG = ""
Case 2, 6
GetG = Mid(strG, 1, 1)
Case 3, 7
GetG = Mid(strG, 2, 1)
Case 4, 8
GetG = Mid(strG, 3, 1)
Case 5
GetG = Mid(strG, 4, 1)
Case 9
GetG = Mid(strG, 5, 1)
End Select
End Function
Private Function ReadLongNumber(ByVal LongX As String) As String
Dim NumberX As String
Dim l As Long '长度
Dim m As Long '多余位数
Dim c As Long '循环次数
Dim i As Long, j As Long '标志
Dim CurN As String
NumberX = LongX
l = Len(NumberX)
Do Until l < 9
m = l Mod 8
If m = 0 Then m = 8
CurN = Left(NumberX, m)
If ReadIntNumber(CurN) <> "零" Then
ReadLongNumber = ReadLongNumber & ReadIntNumber(CurN) & "亿"
Else
ReadLongNumber = ReadLongNumber & "亿"
End If
NumberX = Right(NumberX, Len(NumberX) - m)
l = Len(NumberX)
Loop
ReadLongNumber = ReadLongNumber & ReadIntNumber(NumberX)
If Len(ReadLongNumber) > 2 And Right(ReadLongNumber, 1) = "零" Then '去尾零
ReadLongNumber = Left(ReadLongNumber, Len(ReadLongNumber) - 1)
End If
If Mid(ReadLongNumber, 1, 2) = "壹拾" Then '掐头壹拾
ReadLongNumber = Right(ReadLongNumber, Len(ReadLongNumber) - 1)
Mid(ReadLongNumber, 1, 1) = "拾"
End If
Zero_Count = 0
End Function
Private Function ReadIntNumber(ByVal NumberX As String) As String
Dim l As Long '长度
Dim m As Long '多余位数
Dim c As Long '循环次数
Dim i As Long, j As Long '标志
Dim CurN As String
If Val(NumberX) = 0 Then ReadIntNumber = GetN(0): Exit Function
l = Len(NumberX)
If l > 8 Then Exit Function
m = l Mod 9
CurN = Right(NumberX, m)
For i = Len(CurN) To 1 Step -1
If GetN(Int(Mid(CurN, i, 1))) = "零" And Zero_Count = 1 Then
If GetG(Len(CurN) - i + 1) = "万" Then
If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
End If
Else
If GetN(Int(Mid(CurN, i, 1))) = "零" Then
ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber
If GetG(Len(CurN) - i + 1) = "万" Then
If (Not (Val(Left(CurN, Len(CurN) - 5)) = 0)) Then ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
End If
Zero_Count = 1
Else
ReadIntNumber = GetG(Len(CurN) - i + 1) & ReadIntNumber
ReadIntNumber = GetN(Int(Mid(CurN, i, 1))) & ReadIntNumber
Zero_Count = 0
End If
End If
Next i
'Loop
If Len(ReadIntNumber) > 2 And Right(ReadIntNumber, 1) = "零" Then '去尾零
ReadIntNumber = Left(ReadIntNumber, Len(ReadIntNumber) - 1)
End If
If Mid(ReadIntNumber, 1, 2) = "壹拾" Then '掐头壹拾
ReadIntNumber = Right(ReadIntNumber, Len(ReadIntNumber) - 1)
Mid(ReadIntNumber, 1, 1) = "拾"
End If
End Function
Public Function ReadNumber(ByVal NumberX As String) As String
Dim LongX As String
Dim PointX As String
Dim LongLong As Long
Dim bFS As Boolean '负数
If Not IsNumeric(NumberX) Then
ReadNumber = ""
Exit Function
End If
If CDbl(NumberX) < 0 Then
NumberX = -NumberX
bFS = True
End If
NumberX = CStr(Format(NumberX, "General Number"))
LongLong = InStr(1, NumberX, ".")
If LongLong <> 0 Then
ReadNumber = ReadLongNumber(Left(NumberX, LongLong - 1))
ReadNumber = ReadNumber & "点" & ReadSmallNumber(Right(NumberX, Len(NumberX) - LongLong))
Else
ReadNumber = ReadLongNumber(NumberX)
End If
If bFS = True Then
ReadNumber = "负" & ReadNumber
End If
End Function
Private Function ReadSmallNumber(SmallNumber As String) As String
Dim i As Long
For i = 1 To Len(SmallNumber)
ReadSmallNumber = ReadSmallNumber & GetN(Mid(SmallNumber, i, 1))
Next i
End Function
Private Function ReadSmallNumberToRMB(SmallNumber As String) As String
ReadSmallNumberToRMB = GetN(Mid(SmallNumber, 1, 1)) & "角" & GetN(Mid(SmallNumber, 2, 1)) & "分"
End Function
Public Function ReadNumberToRMB(ByVal NumberX As String) As String
Dim LongX As String
Dim PointX As String
Dim LongLong As Long
Dim bFS As Boolean '负数
If Not IsNumeric(NumberX) Then
ReadNumberToRMB = ""
Exit Function
End If
If CDbl(NumberX) < 0 Then
NumberX = -NumberX
bFS = True
End If
NumberX = CStr(Format(NumberX, "#.00"))
LongLong = InStr(1, NumberX, ".")
If Right(NumberX, Len(NumberX) - LongLong) <> "" Then
ReadNumberToRMB = ReadLongNumber(Left(NumberX, LongLong - 1))
ReadNumberToRMB = ReadNumberToRMB & "元" & ReadSmallNumberToRMB(Right(NumberX, Len(NumberX) - LongLong))
Else
ReadNumberToRMB = ReadLongNumber(NumberX)
End If
If bFS = True Then
ReadNumberToRMB = "负" & ReadNumberToRMB
End If
End Function

'*********************************************************
'* 名称：nNumber2Chinese
'* 功能：数值转换为人民币(汉字)
'* 用法：nNumber2Chinese(数值)
'*********************************************************
Public Function Num2Chi(txtJE As Double) As String
    Dim I, K As Integer
    Dim NC, nd, ka, chrNum, strZheng As String
    Dim c1, c2, c3 As String
    Dim K1 As Integer
    Dim Zheng As String
    Dim Xiao As String
    NC = Trim(Format(txtJE, "##0.00"))
    c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
    c2 = "角分"
    c3 = "玖捌柒陆伍肆叁贰壹"
    If NC = 0 Then
        Num2Chi = "零元整"
        Exit Function
    End If
    Num2Chi = ""
    Zheng = Mid(NC, 1, (Len(NC) - 3))
    Xiao = Mid(NC, (Len(Zheng) + 2))
    If Val(Xiao) <> 0 Then
        For I = Len(Xiao) To 1 Step -1
            chrNum = Mid(Xiao, I, 1)
            If chrNum <> 0 Then
                Num2Chi = Mid(c2, I, 1) & Num2Chi
                Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
            End If
        Next I
    End If

    K = 0
    If Val(Zheng) <> 0 Then
        Num2Chi = "元" & Num2Chi
        For I = Len(Zheng) To 1 Step -1
            If (Len(Zheng) - I) = 4 Then
                Num2Chi = "万" & Num2Chi
            ElseIf (Len(Zheng) - I) = 8 Then
                Num2Chi = "亿" & Num2Chi
            ElseIf (Len(Zheng) - I) = 12 Then
                Num2Chi = "万" & Num2Chi
            End If
            chrNum = Mid(Zheng, I, 1)
            If chrNum <> 0 Then
                If I = Len(Zheng) Then
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                Else
                    If (Len(Zheng) - I) <> 4 And (Len(Zheng) - I) <> 8 And (Len(Zheng) - I) <> 12 Then
                        Num2Chi = Mid(c1, (Len(c1) - K), 1) & Num2Chi
                    End If
                    Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
                End If
            Else
                If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
                    If Mid(Num2Chi, 1, 1) <> "零" Then
                        Num2Chi = "零" & Num2Chi
                    End If
                End If
           End If
            K = K + 1
        Next I
    End If
    If Right(Trim(Num2Chi), 1) <> "分" Then
        Num2Chi = Num2Chi & "整"
    End If
End Function

调试易

如果将小写金额转换成大写金额？

解决方案 »