金额大小写转换

ganjike

很久以用vb前写的 金额小写转换大写程序

Function ChangeMoney(dMoney As String) As String
    Dim Str As String
    Dim val As String
    Dim Rtn As String
    Dim tmp As String
    Dim i, j As Integer
    Dim LenAll As Integer
    Dim dot As Integer
   
    Str = "零壹贰叁肆伍陆柒捌玖"
   
    dot = InStr(dMoney, ".")
   
    If dot <> 0 Then
        If (Len(dMoney) - dot) > 2 Then
            MsgBox "格式错误，小数点后只能小于等于两位"
            ChangeMoney = ""
            Exit Function
        End If
    End If
   
    LenAll = Len(dMoney)
    val = ""
   
    For i = 1 To LenAll
        If i <> dot Then
            '取位值
            tmp = Right(Left(dMoney, i), 1) '取一位
            val = val & Right(Left(Str, CInt(tmp) + 1), 1)
            If dot <> 0 Then
                j = dot - i
            Else
                j = LenAll - i + 1
            End If
            If j > 0 Then
                j = j - 1
                '取加权          "拾佰仟万亿"
                Select Case j
                Case 1
                    val = val & "拾"
                Case 2
                    val = val & "佰"
                Case 3
                    val = val & "仟"
                Case 4
                    val = val & "万"
                Case 5
                    val = val & "拾"
                Case 6
                    val = val & "佰"
                Case 7
                    val = val & "仟"
                Case 8
                    val = val & "亿"
                Case 9
                    val = val & "拾"
                Case 10
                    val = val & "佰"
                Case 11
                    val = val & "仟"
                Case 12
                    val = val & "亿"
                End Select
            Else
                Select Case j
                Case 0
                    val = val & "圆"
                Case -1
                    val = val & "角"
                Case -2
                    val = val & "分"
                End Select
            End If
        Else
            val = val & "圆"
        End If
    Next i
   
   
    ChangeMoney = LoseZero(val)

End Function

Function LoseZero(val As String) As String
   
    Dim Rtn As String
    Dim bZero As Boolean
    Dim bWan As Boolean
    Dim bYi As Boolean
   
    bZero = False
    '去头零
    For i = 1 To Len(val)
        tmp = Right(Left(val, i), 1)
        If tmp = "零" Then
            val = Right(val, Len(val) - 1)
            i = i - 1
            bZero = True
        Else
            If bZero Then
                Select Case tmp
                Case "拾"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case "佰"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case "仟"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case "万"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case "亿"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case "圆"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case "角"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case "分"
                    val = Right(val, Len(val) - 1)
                    i = i - 1
                Case Else
                    Exit For
                End Select
            Else
                Exit For
            End If
            
        End If
    Next i
   
    bWan = False
    bYi = False
    bZero = False
    Rtn = ""
   
    '去零
    For i = 1 To Len(val)
        tmp = Right(Left(val, i), 1)
        If tmp = "万" Then
            bWan = True
        End If
        If tmp = "亿" Then
            bYi = True
        End If
        
        If tmp = "零" Then
            If Not bZero Then
                bZero = True
            End If
        Else
            If bZero Then
               
                Select Case tmp
                Case "拾"
                Case "佰"
                Case "仟"
                Case "万"
                    If bWan Then
                        Rtn = Rtn & tmp
                    End If
                Case "亿"
                    If bYi Then
                        Rtn = Rtn & tmp
                    End If
                Case "角"
                Case "分"
                Case "零"
                '否则
                Case Else
                    bZero = False
                    If tmp <> "圆" Then
                        Rtn = Rtn & "零" & tmp
                    Else
                        Rtn = Rtn & tmp
                    End If
                End Select
            Else
                Rtn = Rtn & tmp
            End If
        End If
    Next i

    LoseZero = Rtn
   
End Function

Damon_2

VB

ganjike

原帖由 Damon 于 2006-10-13 19:54 发表
VB

是的。