Excel将数字转换为单词

时间:2014-03-01 01:29:32

标签: excel excel-vba vba

我正在使用microsoft excel 2010我希望为输入单元格的数字提供相应的单词金额。

例如,在单元格A3中,我们有340

然后在单元格A4中我们有Three Hundred and Forty

欢迎任何建议或公式。

1 个答案:

答案 0 :(得分:1)

参考http://www.ozgrid.com/VBA/CurrencyToWords.htm

Sub Main()
    MsgBox ConvertCurrencyToEnglish(100)
End Sub

Function ConvertCurrencyToEnglish(ByVal MyNumber)

    Dim Temp
    Dim Dollars, Cents
    Dim DecimalPlace, Count

    ReDim Place(9) As String

    Place(2) = " Thousand "

    Place(3) = " Million "

    Place(4) = " Billion "

    Place(5) = " Trillion "

    ' Convert MyNumber to a string, trimming extra spaces.

    MyNumber = Trim(Str(MyNumber))

    ' Find decimal place.

    DecimalPlace = InStr(MyNumber, ".")

    ' If we find decimal place...

    If DecimalPlace > 0 Then

        ' Convert cents
        Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)

        Cents = ConvertTens(Temp)

        ' Strip off cents from remainder to convert.
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

    End If

    Count = 1

    Do While MyNumber <> ""

        ' Convert last 3 digits of MyNumber to English dollars.

        Temp = ConvertHundreds(Right(MyNumber, 3))

        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

        If Len(MyNumber) > 3 Then
            ' Remove last 3 converted digits from MyNumber.
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If

        Count = Count + 1

    Loop

    ' Clean up dollars.
    Select Case Dollars
    Case ""
        Dollars = "No Dollars"
    Case "One"
        Dollars = "One Dollar"
    Case Else
        Dollars = Dollars & " Dollars"
    End Select

    ' Clean up cents.
    Select Case Cents
    Case ""
        Cents = " And No Cents"
    Case "One"
        Cents = " And One Cent"
    Case Else
        Cents = " And " & Cents & " Cents"
    End Select

    ConvertCurrencyToEnglish = Dollars & Cents

End Function

Private Function ConvertHundreds(ByVal MyNumber)

    Dim Result As String
    ' Exit if there is nothing to convert.

    If Val(MyNumber) = 0 Then Exit Function

    ' Append leading zeros to number.

    MyNumber = Right("000" & MyNumber, 3)

    ' Do we have a hundreds place digit to convert?

    If Left(MyNumber, 1) <> "0" Then
        Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
    End If

    ' Do we have a tens place digit to convert?

    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & ConvertTens(Mid(MyNumber, 2))
    Else
        ' If not, then convert the ones place digit.
        Result = Result & ConvertDigit(Mid(MyNumber, 3))
    End If

    ConvertHundreds = Trim(Result)

End Function

Private Function ConvertTens(ByVal MyTens)

    Dim Result As String

    ' Is value between 10 and 19?

    If Val(Left(MyTens, 1)) = 1 Then

        Select Case Val(MyTens)

        Case 10: Result = "Ten"

        Case 11: Result = "Eleven"

        Case 12: Result = "Twelve"

        Case 13: Result = "Thirteen"

        Case 14: Result = "Fourteen"

        Case 15: Result = "Fifteen"

        Case 16: Result = "Sixteen"

        Case 17: Result = "Seventeen"

        Case 18: Result = "Eighteen"

        Case 19: Result = "Nineteen"

        Case Else

        End Select

    Else

        ' .. otherwise it's between 20 and 99.

        Select Case Val(Left(MyTens, 1))

        Case 2: Result = "Twenty "

        Case 3: Result = "Thirty "

        Case 4: Result = "Forty "

        Case 5: Result = "Fifty "

        Case 6: Result = "Sixty "

        Case 7: Result = "Seventy "

        Case 8: Result = "Eighty "

        Case 9: Result = "Ninety "

        Case Else

        End Select

        ' Convert ones place digit.

        Result = Result & ConvertDigit(Right(MyTens, 1))

    End If

    ConvertTens = Result

End Function


Private Function ConvertDigit(ByVal MyDigit)

    Select Case Val(MyDigit)

    Case 1: ConvertDigit = "One"

    Case 2: ConvertDigit = "Two"

    Case 3: ConvertDigit = "Three"

    Case 4: ConvertDigit = "Four"

    Case 5: ConvertDigit = "Five"

    Case 6: ConvertDigit = "Six"

    Case 7: ConvertDigit = "Seven"

    Case 8: ConvertDigit = "Eight"

    Case 9: ConvertDigit = "Nine"

    Case Else: ConvertDigit = ""

    End Select

End Function