模块/类模块
数字转英文的多种实现方法
2016-12-08 22:27:07

数字转中文大写金额Office中国有很多相关的现成函数和代码了。但小写数字转英文金额还真不是太多。

今天有时间将Office中国论坛和Access中国以前的技巧整理了一下,形成了多种阿拉伯数字转换英文数字的方法:

一、作者:stone0823-Office中国

以前在Excel中写的两个自定义函数,NumberToEnglish将一个数字转换成英文大写,NumToChi将一个数字转换成中文大写,算法容易理解。现贴上来,请大家多支持。

  

Public Function NumToChi(Figure) As String

    Dim lFigure1 As Long

    Dim lFigure2 As Long

    Dim lFigure3 As Long

    'Not a figure

    If Not IsNumeric(Figure) Then

        NumToChi = "#NotANumber"

        Exit Function

    End If

    Call InitChiFig

    'Round the figure

    Figure = Round(Figure, 2)

    '0 to 10,000

    If Figure >= 0 And Figure < 10000 Then

        lFigure1 = Int(Figure)

        lFigure2 = (Figure - lFigure1) * 100

        If lFigure2 = 0 Then

            NumToChi = NumToChi_01(lFigure1)

        Else

            NumToChi = NumToChi_01(lFigure1) _

                & "点" & NumToChi_02(lFigure2)

        End If

    End If

    '10,000 to 100,000,000

    If Figure >= 10000 And Figure < 100000000 Then

        lFigure1 = Figure \ 10000

        lFigure2 = Int(Figure - lFigure1 * 10000)

        lFigure3 = (Figure - lFigure1 * 10000 - lFigure2) * 100

        '100

        If lFigure2 = 0 And lFigure3 = 0 Then

            NumToChi = NumToChi_01(lFigure1) & "万"

        End If

        '101

        If lFigure2 = 0 And lFigure3 <> 0 Then

            NumToChi = NumToChi_01(lFigure1) & "万点" _

                & NumToChi_02(lFigure3)

        End If

        '110

        If lFigure2 <> 0 And lFigure3 = 0 Then

            If lFigure2 < 1000 Then

                 NumToChi = NumToChi_01(lFigure1) & "万零" _

                    & NumToChi_01(lFigure2)

            Else

                NumToChi = NumToChi_01(lFigure1) & "万" _

                    & NumToChi_01(lFigure2)

            End If

        End If

        '111

        If lFigure2 <> 0 And lFigure3 <> 0 Then

            If lFigure2 < 1000 Then

                NumToChi = NumToChi_01(lFigure1) & "万零" _

                    & NumToChi_01(lFigure2) & "点" _

                    & NumToChi_02(lFigure3)

            Else

                 NumToChi = NumToChi_01(lFigure1) & "万" _

                    & NumToChi_01(lFigure2) & "点" _

                    & NumToChi_02(lFigure3)

            End If

        End If

    End If

    If Figure >= 100000000 Then '100,000,000

        NumToChi = "#NotDefined"

    End If

End Function

二、作者:fe2o3-Office中国

Dim StrNO(19) As String

Dim Unit(8) As String

Dim StrTens(9) As String

Public Function NumberToString(Number As Double) As String

    Dim Str As String, BeforePoint As String, AfterPoint As String, tmpStr As String

    Dim Point As Integer

    Dim nBit As Integer

    Dim CurString As String

    Call Init

    '"//开始处理

    Str = CStr(Round(Number, 2))

    ' Str = Number

    If InStr(1, Str, ".") = 0 Then

        BeforePoint = Str

        AfterPoint = ""

    Else

        BeforePoint = Left(Str, InStr(1, Str, ".") - 1)

        AfterPoint = Right(Str, Len(Str) - InStr(1, Str, "."))

        If Len(AfterPoint) = 1 Then

            AfterPoint = AfterPoint & "0"

        End If

    End If

    If Len(BeforePoint) > 12 Then

        NumberToString = "Too Big."

        Exit Function

    End If

    Str = ""

    Do While Len(BeforePoint) > 0

        nNumLen = Len(BeforePoint)

        If nNumLen Mod 3 = 0 Then

            CurString = Left(BeforePoint, 3)

            BeforePoint = Right(BeforePoint, nNumLen - 3)

        Else

            CurString = Left(BeforePoint, (nNumLen Mod 3))

            BeforePoint = Right(BeforePoint, nNumLen - (nNumLen Mod 3))

        End If

        nBit = Len(BeforePoint) / 3

        tmpStr = DecodeHundred(CurString)

        If (BeforePoint = String(Len(BeforePoint), "0") Or nBit = 0) And Len(CurString) = 3 Then

            If CInt(Left(CurString, 1)) <> 0 And CInt(Right(CurString, 2)) <> 0 Then

                tmpStr = Left(tmpStr, InStr(1, tmpStr, Unit(4)) + Len(Unit(4))) & Unit(8) & " " & Right(tmpStr, Len(tmpStr) - (InStr(1, tmpStr, Unit(4)) + Len(Unit(4))))

            ElseIf CInt(Left(CurString, 1)) <> 0 And CInt(Right(CurString, 2)) = 0 Then

                tmpStr = Unit(8) & " " & tmpStr

            End If

        End If

        If nBit = 0 Then

            Str = Trim(Str & " " & tmpStr)

        Else

            Str = Trim(Str & " " & tmpStr & " " & Unit(nBit))

        End If

        If Left(Str, 3) = Unit(8) Then Str = Trim(Right(Str, Len(Str) - 3))

        If BeforePoint = String(Len(BeforePoint), "0") Then Exit Do

        Debug.Print Str

    Loop

    BeforePoint = Str

    If Len(AfterPoint) > 0 Then

        AfterPoint = Unit(6) & " " & DecodeHundred(AfterPoint) & " " & Unit(7)

    Else

        AfterPoint = Unit(5)

    End If

    NumberToString = BeforePoint & " " & AfterPoint

End Function

Private Function DecodeHundred(HundredString As String) As String

    Dim tmp As Integer

    If Len(HundredString) > 0 And Len(HundredString) <= 3 Then

        Select Case Len(HundredString)

        Case 1

            tmp = CInt(HundredString)

            If tmp <> 0 Then DecodeHundred = StrNO(tmp)

        Case 2

            tmp = CInt(HundredString)

            If tmp <> 0 Then

                If (tmp < 20) Then

                    DecodeHundred = StrNO(tmp)

                Else

                    If CInt(Right(HundredString, 1)) = 0 Then

                        DecodeHundred = StrTens(Int(tmp / 10))

                    Else

                        DecodeHundred = StrTens(Int(tmp / 10)) & "-" & StrNO(CInt(Right(HundredString, 1)))

                    End If

                End If

            End If

        Case 3

            If CInt(Left(HundredString, 1)) <> 0 Then

                DecodeHundred = StrNO(CInt(Left(HundredString, 1))) & " " & Unit(4) & " " & DecodeHundred(Right(HundredString, 2))

            Else

                DecodeHundred = DecodeHundred(Right(HundredString, 2))

            End If

        Case Else

        End Select

    End If

End Function

Private Sub Init()

    If StrNO(1) <> "One" Then

        StrNO(1) = "One"

        StrNO(2) = "Two"

        StrNO(3) = "Three"

        StrNO(4) = "Four"

        StrNO(5) = "Five"

        StrNO(6) = "Six"

        StrNO(7) = "Seven"

        StrNO(8) = "Eight"

        StrNO(9) = "Nine"

        StrNO(10) = "Ten"

        StrNO(11) = "Eleven"

        StrNO(12) = "Twelve"

        StrNO(13) = "Thirteen"

        StrNO(14) = "Fourteen"

        StrNO(15) = "Fifteen"

        StrNO(16) = "Sixteen"

        StrNO(17) = "Seventeen"

        StrNO(18) = "Eighteen"

        StrNO(19) = "Nineteen"

        StrTens(1) = "Ten"

        StrTens(2) = "Twenty"

        StrTens(3) = "Thirty"

        StrTens(4) = "Forty"

        StrTens(5) = "Fifty"

        StrTens(6) = "Sixty"

        StrTens(7) = "Seventy"

        StrTens(8) = "Eighty"

        StrTens(9) = "Ninety"

        Unit(1) = "Thousand" '第一个三位

        Unit(2) = "Million" '第二个三位

        Unit(3) = "Billion" '第三个三位

        Unit(4) = "Hundred"

        Unit(5) = "Only"

        Unit(6) = "Point"

        Unit(7) = "Cent" '不是货币的话,把此值赋空

        Unit(8) = "And"

    End If

End Sub