再论数字转成英文大写

阿罗

刚才在精华区看到对此一个回帖，同时查了有关帖子，感觉程序的清晰度、扩展性都不是很好。现在我将自己的一个习作发表如下

（一共有两个函数，但transbig是正式用来使用的。换言之，transmall只是提供给transbig使用。最大转换数字999,999,999.99）

Function transmall(x As Integer) As String
Dim a(90) As String, d1, d2, d3 As Integer
a(0) = ""
a(1) = "ONE"
a(2) = "TWO"
a(3) = "THREE"
a(4) = "FOUR"
a(5) = "FIVE"
a(6) = "SIX"
a(7) = "SEVEN"
a(8) = "EIGHT"
a(9) = "NINE"
a(10) = "TEN"
a(11) = "ELEVEN"
a(12) = "TWELVE"
a(13) = "THIRTEEN"
a(14) = "FOURTEEN"
a(15) = "FIFTEEN"
a(16) = "SIXTEEN"
a(17) = "SEVENTEEN"
a(18) = "EIGHTEEN"
a(19) = "NINETEEN"
a(20) = "TWENTY"
a(30) = "THIRTY"
a(40) = "FORTY"
a(50) = "FIFTY"
a(60) = "SIXTY"
a(70) = "SEVENTY"
a(80) = "EIGHTY"
a(90) = "NINETY"

d1 = x \ 100
d2 = (x - d1 * 100) \ 10
d3 = x - d1 * 100 - d2 * 10

If d2 < 2 Then
    If d1 <> 0 Then
        If d2 = 0 And d3 = 0 Then
            transmall = a(d1) & " HUNDRED "
        Else
            transmall = a(d1) & "HUNDRED AND " & a(d2 * 10 + d3)
        End If
   Else
        transmall = a(d2 * 10 + d3)
   End If
Else
    If d1 <> 0 Then
        transmall = a(d1) & " HUNDRED AND " & a(d2 * 10) & " " & a(d3)
    Else
        transmall = a(d2 * 10) & " " & a(d3)
    End If
End If
End Function


Function transbig(x As Double) As String
'/////maximun 999,999,999.99
Dim part1, part2 As Long, sect1, sect2, sect3 As Integer, a As Double
'/////a 是临时变量
'/////part1 是x的小数点前的整数部分
'/////sect1 是 999,999,999的前三位, sect2......
part1 = x \ 1
If part1 > x Then part1 = part1 - 1
a = x - part1
part2 = (a * 100) \ 1

sect1 = part1 \ 1000000
sect2 = (part1 - sect1 * 1000000) \ 1000
sect3 = part1 - sect1 * 1000000 - sect2 * 1000

If sect1 <> 0 Then
    If sect2 <> 0 Then
        If sect3 <> 0 Then
            transbig = transmall((sect1)) & " MILLION AND " & transmall((sect2)) & " THOUSAND AND " & transmall((sect3))
        Else
            transbig = transmall((sect1)) & " MILLION AND " & transmall((sect2)) & " THOUSAND"
        End If
    Else
        If sect3 <> 0 Then
            transbig = transmall((sect1)) & " MILLION AND " & transmall((sect3))
        Else
            transbig = transmall((sect1)) & " MILLION"
        End If
    End If
Else
    If sect2 <> 0 Then
        If sect3 <> 0 Then
            transbig = transmall((sect2)) & " THOUSAND AND " & transmall((sect3))
        Else
            transbig = transmall((sect2)) & " THOUSAND"
        End If
    Else
        If sect3 <> 0 Then
            transbig = transmall((sect3))
        Else
            transbig = ""
        End If
    End If
End If
End Function

鉴于英文大写数字的写法是每三位一个位名，以上算法也很容易扩展到BILLION, TRILLION。不再啰嗦。

阿罗

是999,999,999。不好意思。小数部分忘了。有兴趣的话请自行添加这部分功能哦。